home *** CD-ROM | disk | FTP | other *** search
/ Wildcat Gold - The Optical BBS / Wildcat Gold - The Optical BBS (The Golden ROM Series)(Volume 4 Number 1)(The Digital Publishing Company)(1992).ISO / sdn / ca28_3a.sdn / BBS.SRC < prev    next >
Text File  |  1991-08-31  |  75KB  |  2,407 lines
  1. ; ----- COM-AND Scripted BBS mode
  2. ;    Commenced: 03/18/88 R.McG
  3. ;    Updated:    2/--/89 R.McG
  4. ;           10/--/89 R.McG (Allow blank lines, preserve lines to disc)
  5. ;    Ver 1.1:   11/--/90 R.McG (Make BBSETUP utility script)
  6. ; -----------------------------------------------------------------------
  7. ;    Goals:
  8. ;    o    Must autodetect caller's baud rate
  9. ;    o    Must work correctly for modems reporting true CD and otherwise.
  10. ;
  11. ;    Functions:
  12. ;    o    ID/Passworded log-on (with registration)
  13. ;    o    Capabilities set by SYSOP
  14. ;    o    UP and DOWNLOADS
  15. ;    o    Mail and bulletins
  16. ;    o    Privileged access (Pathlist,CHDIR, DOS commands)
  17. ; -----------------------------------------------------------------------
  18. ;    Usages:
  19. ;      S0 ------> General scratch buffer
  20. ;      S1 ------> ID;password during logon; ID after logon upper cased
  21. ;      S2-S5 ---> scratch
  22. ;      S6 ------> Logon time (used by Read_Comm to timeout)
  23. ;      S7 ------> scratch
  24. ;      S8 ------> Scratch buffer
  25. ;      S9 ------> General read buffer
  26. ;      S10-S18 -> Scratch buffers
  27. ;      S19 -----> Is used to save default subdir within commands
  28. ;      S20-S25 -> Default values from BBSDAT
  29. ;             S20 -> port, speed
  30. ;             S21 -> modem init we'll use for restart
  31. ;             S22 -> BBS default subdir
  32. ;             S23 -> BBS default files subdir
  33. ;             S24 -> BBS default mail subdir
  34. ;             S25 -> BBS default bulletin subdir
  35. ;      S28 -----> DLDIR on entry
  36. ;      S29 -----> subdirectory on entry
  37. ;
  38. ;      N0 ------> # minutes allowed for call (set by logon)
  39. ;      N10-N19 -> Generally scratch
  40. ;      N97-N99 -> Generally scratch
  41. ;
  42. ;      FLAG(0) -> ON if an error condition is being reported...
  43. ;          Upon return from Read_Comm: ON -> timeout or disconn
  44. ;          Upon return from Logon -> OFF -> Logon OK
  45. ;      FLAG(1) -> After Logon, privileged access if ON
  46. ;      FLAG(2) -> a CHDIR has been performed by a privileged user
  47. ;      FLAG(3) -> There is a logged on caller (if true)
  48. ; -----------------------------------------------------------------------
  49. ;
  50.     LEGEND "Scripted BBS (1.1); initializing"
  51.     WOPEN 10,1  12,78 (default)
  52.     ATSAY 11,3 (default) "Initializing BBS.. "
  53. ;
  54. ;    Set default values (in case BBSDAT does not exist)
  55. ;
  56.     S20 = "_PARM"(11:14)*","*"_PARM"(0:3) ; Port(4),speed(4)
  57.     S21 = "ATE0Q0V1X1S0=2 S7=30 S9=10^M"; Standard MINIT for BBS
  58.     S22 = "\BBS"; Set to our subdirectory
  59.     S23 = "\BBS\FILES"; Set subdir for files
  60.     S24 = "\BBS\MAIL"; Set subdir for mail
  61.     S25 = "\BBS\BULLETIN"; Set subdir for bulletins
  62. ;
  63. ;    Initialize COM related values (This is done here to allow BBSDAT
  64. ;    ... edits to override these settings)
  65. ;
  66.     SET PARITY NONE         ; BBS is fixed no parity
  67.     SET DATA 8            ; BBS is fixed 8 data bits
  68.     SET STOP 1            ; bbs is fixed 1 stop bit
  69.     SET MASK ON            ; accept 7 or 8 bits
  70.     SET CR_IN CR_LF         ; Display received c/rs as a cr/lf
  71.     SET ASCII UP_LF LF        ; Send LFs
  72.     SET SOFTFLOW ON         ; Allow XON/XOFF
  73.     SET ZMODEM AUTO OFF        ; Automatic ZMODEM (user must say 'z')
  74.     SET ZMODEM RECOVER OFF        ; No ZMODEM recovery
  75. ;
  76. ;    Replace above values from BBSDAT, if that script exists
  77. ;
  78.     IF ISSC "BBSDAT"
  79.     FCALL "BBSDAT"
  80.     ELSE
  81.     S10 = "_SCRIPT"; Get current script fname
  82.     GOSUB Parse_Fname        ; Extract drive:Subdir from name
  83.     S10 = S10*"\BBSDAT"          ; Make new name
  84.     IF ISSC S10 FCALL S10    ; Invoke it if its THERE
  85.     ENDIF
  86. ;
  87. ;    Initialize variables that must be constant
  88. ;
  89.     SUBDIR S29            ; Read current subdir
  90.     DLDIR S28            ; Read current download subdir
  91.  
  92.     FFIRST S22            ; Test for presence of main subd
  93.     IF FAILURE or NOT ISFILE S22*"\BBS-User" ; Test presence of user file
  94.     WCLOSE            ; Clear 'initializing' window
  95.     GOTO NoUser            ; .. Skip if not found
  96.     ENDIF
  97. ;
  98. ;    Initialize other values
  99. ;
  100.     SET BAUD S20(5:8)        ; Starting speed
  101.     SET PORT S20(0:3)        ; Starting port
  102.     SET INAFTER OFF         ; Turn off init after hangup
  103. ;
  104. ;    Initialize other values
  105. ;
  106.     SET ALARM OFF            ; Turn off alarm
  107.     SET ATIME 1            ; Set alarm time to 1 second
  108.     CHDIR S22            ; Set to our subdirectory
  109.     SET DLDIR S23            ; Set DLDIR
  110.     LEGEND "Scripted BBS (1.1);  Press ESC to terminate or to CHAT."
  111.     TRANSMIT "_MESCAPE"; Initialize modem (modem escape)
  112.     WCLOSE                ; End init (before ON ESC)
  113.  
  114.     ON ESCAPEGOSUB Escape        ; Enter chat mode on operator escape
  115.     S9 = "* BBS script loaded"; Set text of msg
  116.     CLOG S9             ; .. to call log
  117.     GOSUB Log_Item            ; .. and to BBS-Log
  118.     GOTO Restart            ; Branch around subroutines
  119. ; -----------------------------------------------------------------------
  120. ;    Subroutine: Parse drive:subdirectory from file name
  121. ;
  122. ;    S10 passes fully name        S10 returns drive:subdirectory
  123. ;                    S11 returns file name
  124. ;    N10,N11 are scratch values
  125. ; -----------------------------------------------------------------------
  126. ;
  127. Parse_Fname:
  128.     LENGTH S10 N10            ; Find length of string
  129.     FOR N11 = (N10-1),0,-1        ; Scan backwards through string
  130.         IF STRCMP S10(N11:N11) ":" or STRCMP S10(N11:N11) "\"GOTO PAFN100
  131.         ENDFOR
  132.     S11 = S10            ; No drive or path
  133.     S10 = ""; Return null drive:path spec
  134.     RETURN
  135. ;
  136. ;    Extract drive and path from name; N11 points to ":" or "\"
  137. ;
  138. PAFN100:
  139.     S11 = S10(N11+1:N10)        ; Extract name portion
  140.     IF STRCMP S10(N11:N11) "\"DEC N11
  141.     S10 = S10(0:N11)        ; Save ":", remove last "\"
  142.     RETURN
  143. ; -----------------------------------------------------------------------
  144. ;    Subroutine: No user ID file
  145. ;
  146. ;    S0 is used as scratch
  147. ; -----------------------------------------------------------------------
  148. ;
  149. NoUser:
  150. ;
  151. ;    Issue a pop-up
  152. ;
  153.     LEGEND "Scripted BBS (1.1);  Error initializing"
  154.     WOPEN 10,10,17,70 (default) NoUser_End
  155.     ATSAY 10,12 (default) " BBS initialization "
  156.     ATSAY 11,12 (default) "There is no user ID file (BBS-User) to be found on the"
  157.     ATSAY 12,12 (default) "subdirectory: "*S22
  158.     ATSAY 14,12 (default) "The script BBSETUP must be used to identify the subdir-"
  159.     ATSAY 15,12 (default) "ectory used by this BBS, and to create and maintain the"
  160.     ATSAY 16,12 (default) "files it uses."
  161.     ATSAY 17,29 (default) " Press any key to continue "
  162.     KEYGET S0
  163. NoUser_End:
  164.     WCLOSE                ; Close window we opened
  165.     EXIT                ; Finish - no changes need be reset
  166. ;
  167. ; -----------------------------------------------------------------------
  168. ;    Subroutine: Operator ESCAPE
  169. ; -----------------------------------------------------------------------
  170. ;
  171. Escape:
  172.     CURSOR N98,N97
  173.     WOPEN     10,1  20,78 (default) ESC_ESC
  174.     ATSAY     10,3  (default) " BBS Operator menu "
  175.     ATSAY     12,3  (default) "1) Terminate the BBS"
  176.     IF FLAG(3)                ; Not during call
  177.        ATSAY 13,3  (default) "2) Enter chat with caller"
  178.     ELSE
  179.     ATSAY 13,3  (default) ".. No caller currently on "
  180.     ENDIF
  181.     ATSAY     14,3  (default) "3) Cancel this window"
  182.     ATSAY     15,1  (default) "├────────────────────────────────────────────────────────────────────────────┤"
  183.     IF ISSCRIPT "BBMAINT" and NOT FLAG(3) ; Not during call
  184.        ATSAY 16,3  (default) "4) Invoke BBS maintenance scripts"
  185.     ELSE
  186.     ATSAY 16,3  (default) ".. Maintenance script not available"
  187.     ENDIF
  188.     IF ISSCRIPT "BBSETUP" and NOT FLAG(3) ; Not during call
  189.        ATSAY 17,3  (default) "5) Invoke BBS setup script"
  190.     ELSE
  191.     ATSAY 17,3  (default) ".. Setup script not available"
  192.     ENDIF
  193.     ATSAY     18,1  (default) "├────────────────────────────────────────────────────────────────────────────┤"
  194.     ATSAY     19,3  (default) "Select item: "
  195.     ATSAY     20,31 (default) " Press ESC to cancel "
  196.     LOCATE 19,16
  197.     KEYGET S0
  198.     WCLOSE
  199.     LOCATE N98,N97
  200. ;
  201. ;    Interpret the response
  202. ;
  203.     SWITCH S0                ; Interpret resp in S0
  204.     CASE "1"; Terminate
  205.         GOTO End
  206.     ENDCASE
  207.     CASE "2"; Chat
  208.         IF FLAG(3)GOTO Chat
  209.        ENDCASE
  210.     CASE "3"; Bulletin
  211.         RETURN
  212.        ENDCASE
  213.     CASE "4"; Maintenance
  214.         GOSUB EndBBS            ; Terminate BBS
  215.           IF ISFILE "BBMaint" EXECUTE "BBMaint"
  216.        ENDCASE
  217.     CASE "5"; Setup
  218.         GOSUB EndBBS            ; Terminate BBS
  219.           IF ISFILE "BBSetup" EXECUTE "BBSetup"
  220.        ENDCASE
  221.  
  222.        DEFAULT                ; None of the above
  223.           SOUND 100,100            ; Rsapberry
  224.        ENDCASE
  225.     ENDSWITCH
  226.     GOTO Escape
  227. ;
  228. ;    Escape during ESCAPEwindow
  229. ;
  230. ESC_ESC:
  231.     S0 = "3"; Selection = return
  232.     RETURN                    ; We're done
  233. ;
  234. ; -----------------------------------------------------------------------
  235. ;    Subroutine: End of BBS
  236. ; -----------------------------------------------------------------------
  237. ;
  238. End:
  239.     GOSUB EndBBS
  240.     EXIT
  241. ;
  242. ; -----------------------------------------------------------------------
  243. ;    Subroutine: End of BBS
  244. ; -----------------------------------------------------------------------
  245. ;
  246. EndBBS:
  247.     SET TTHRU OFF            ; Inhibit type thru
  248.     WOPEN 10,1  12,78 (default)
  249.     ATSAY 11,3 (default) "Terminating BBS.. "
  250.  
  251.     HANGUP                ; Hangup the phone
  252.     S9 = "* BBS script terminated"; Set msg to log
  253.     CLOG S9             ; Log completion
  254.     GOSUB Log_Item            ; .. both places
  255.     SET DLDIR S28            ; Reset dldir
  256.     CHDIR S29            ; Reset to default directory
  257.     RESET                ; Reset default values
  258.     CLEAR                ; Clear screen
  259.     MESS "BBS terminated... type Alt-X to exit COM-AND^M^J^M^J"
  260.     TRAN "_MINIT"; Initialize modem from defaults
  261.     DELETE "\HOSTTEMP.TXT"          ; Cleanup
  262.  
  263.     WCLOSE
  264.     RETURN                ; We're done
  265. ; -----------------------------------------------------------------------
  266. ;    Subroutine: Chat mode: Operator entered escape
  267. ;
  268. ;    S0 is used as scratch
  269. ; -----------------------------------------------------------------------
  270. ;
  271. Chat:
  272. ;
  273. ;    Start chat mode.
  274. ;
  275.     TRAN "^M^J"                     ; Send a c/r
  276.     TRAN "^M^JOperator initiated chat mode..."
  277.     S2 = "_LEGEND"                  ; Save previous legend
  278.     LEGEND "Scripted BBS (1.1);  Chat mode; null entry at prompt to exit"
  279. ;
  280. ;    Read from the operator
  281. ;
  282. Chat_Loop:
  283.     MESS "^M^JSYSOP: "              ; Prompt
  284.     GET S0 80            ; Read from kbd
  285.  
  286.     IF NULL S0            ; If blank entry
  287.        MESS "Continue? (Y/N, cr=y): "
  288.      GET S0 2            ; Read a response
  289.     IF FIND S0 "N"; If response was no
  290.           TRAN "^M^JChat terminated by SYSOP"
  291.      LEGEND S2         ; Restore previous legend
  292.           RETURN            ; Return to what we were doing
  293.         ENDIF
  294.        S0 = " "                     ; Make a blank line
  295.     ENDIF
  296.     TRAN "^M^JSYSOP: "
  297.     TRAN S0             ; Send the line
  298. ;
  299. ;    Read from the caller
  300. ;
  301.     MESS "Caller: "                 ; NO c/r req'd
  302.     TRAN "^M^JCaller: "             ; Prompt
  303.     GOSUB Read_Comm         ; read the comm port
  304.     IF FLAG(0)            ; If caller disconn
  305.        MESS "^M^JCaller disconnected"; Inform sysop
  306.        LEGEND S2            ; Restore previous legend
  307.        RETURN            ; ANd return
  308.     ENDIF
  309.     GOTO Chat_Loop            ; And continue
  310. ; -----------------------------------------------------------------------
  311. ;    Subroutine: Limit time on-line
  312. ;    .. S6 -> Time of logon
  313. ;    .. N0 -> Max minutes allowed
  314. ;
  315. ;    FLAG(0) off -> Time remaining
  316. ;        on --> Disconnect the caller
  317. ;
  318. ;    S9 and N18,N19 are used as scratch
  319. ; -----------------------------------------------------------------------
  320. ;
  321. Limit_Time:
  322. ;
  323. ;    If privileged user, just return true
  324. ;
  325.     IF FLAG(1)            ; If privileged user
  326.        SET FLAG(0) OFF        ; Return OK
  327.        RETURN            ; Return to caller
  328.     ENDIF
  329. ;
  330. ;    Convert times to numeric quantities
  331. ;
  332.     TIME S9 1            ; Get current time (military fmt)
  333.     N19 = S9(0:1)*60+S9(3:4)    ; Compute current time since midnight
  334.     N18 = S6(0:1)*60+S6(3:4)    ; Time of logon since midnight
  335. ;
  336. ;    And test the time remaining
  337. ;
  338.     IF GT N18 N19            ; If timeout on the RGET
  339.     N19 = N19+1440        ; Allow wrap accross midnight
  340.     ENDIF
  341.     N19 = N19-N18            ; COmpute time on
  342.  
  343.     IF GT N19 N0            ; Test against logon determined time
  344.     TRAN "^M^JYour alotted time has expired..."
  345.      TRAN "^M^JYou are being disconnected."
  346.      SET FLAG(0) ON        ; Indicate disconnect
  347.        RETURN            ; RETURN to caller
  348.     ENDIF
  349. ;
  350. ;    Return 'OK'
  351. ;
  352.     SET FLAG(0) OFF         ; Report to caller
  353.     RETURN                ; Return with text in S9
  354. ; -----------------------------------------------------------------------
  355. ;    Subroutine: Read from the caller into S9
  356. ;    .. This handles 'disconnect' and timeouts.
  357. ;
  358. ;    FLAG(0) off -> Line read correctly
  359. ;        on --> Disconnect or timeout
  360. ; -----------------------------------------------------------------------
  361. ;
  362. Read_Comm:
  363. ;
  364. ;    Test timeout
  365. ;
  366.     IF FLAG(3)            ; If user logged on now
  367.      GOSUB Limit_Time        ; Test time on-line
  368.     IF FLAG(0) RETURN        ; If error returns set, end proc here
  369.     ENDIF
  370. ;
  371. ;    Now, sit on the COMM port waiting for a read
  372. ;
  373.     RGET S9 80 180            ; Wait for a connection
  374.     IF NOT CONNECTEDGOTO Disconnect; If modem reports CD dropped
  375.     IF FAILEDGOTO Timeout        ; If timeout on the RGET issue msg and disconn
  376.     FIND S9 "NO CARRIER"            ; Test for message from modem
  377.     IF FOUND GOTO Disconnect    ; If modem didn't report 'CD' true
  378. ;
  379. ;    Return 'text read'
  380. ;
  381.     SET FLAG(0) OFF         ; Report to caller
  382.     RETURN                ; Return with text in S9
  383. ;
  384. ;    Timeout on the call
  385. ;
  386. Timeout:
  387.     TRAN "^M^J... autodisconnect due to timeout^M^J"
  388.     MESSAGE "^M^J... autodisconnect due to timeout"
  389.     GOTO RComm_Exit         ; Exit cycle in the usual manner
  390. ;
  391. ;    Disconnect was reported.
  392. ;
  393. Disconnect:
  394.     MESSAGE  "^M^JCaller disconnected"
  395. ;
  396. ;    Read_Comm error exit
  397. ;
  398. RComm_Exit:
  399.     SET FLAG(0) ON            ; Report to caller
  400.     RETURN                ; Return to the caller
  401. ; -----------------------------------------------------------------------
  402. ;    Subroutine: Display the # of allotted minutes remaining
  403. ;    .. S6 -> Time of logon
  404. ;    .. N0 -> Max minutes allowed
  405. ;
  406. ;    S9 and N18,N19 are used as scratch
  407. ; -----------------------------------------------------------------------
  408. ;
  409. Display_Limit:
  410. ;
  411. ;    If privileged user, just return (no message)
  412. ;
  413.     IF FLAG(1) RETURN        ; If privileged user, rtn to caller
  414. ;
  415. ;    Convert times to numeric quantities
  416. ;
  417.     TIME S9 1            ; Get current time (military fmt)
  418.     N19 = S9(0:1)*60+S9(3:4)    ; Compute current time since midnight
  419.     N18 = S6(0:1)*60+S6(3:4)    ; Time of logon since midnight
  420. ;
  421. ;    Compute the time remaining
  422. ;
  423.     IF GT N18 N19            ; If timeout on the RGET
  424.     N19 = N19+1440        ; Allow wrap accross midnight
  425.     ENDIF
  426.     N19 = N0-(N19-N18)        ; Compute remaining time
  427. ;
  428. ;    Display the quantity and we're done
  429. ;
  430.     STRFMT S9 "^M^J(%d minutes remaining)" N19
  431.     TRAN S9
  432.     RETURN                ; Return with text in S9
  433. ; -----------------------------------------------------------------------
  434. ;    Subroutine: Logon - ID/password are in S1 (0:15)
  435. ;
  436. ;    On exit:
  437. ;    FLAG(0) ON -> indicate falure of logon
  438. ;    FLAG(1) ON -> if logon successful to indicate privileged access
  439. ; -----------------------------------------------------------------------
  440. ;
  441. Logon:
  442.     FOPENI "BBS-User" TEXT          ; OPEN file for input
  443.     IF FAILED            ; if open failed
  444.        SET FLAG(0) ON        ; Report an error
  445.        RETURN            ; Return to caller
  446.     ENDIF
  447. ;
  448. ;    Read records from BBS-User
  449. ;
  450. Logon_Loop:
  451.     READ S9 80 N19            ; Read a record      * COM-AND
  452.     IF EOF                ; Test for EOF
  453.     FCLOSEI            ; CLose the input file
  454.        SET FLAG(0) ON        ; Report an error
  455.        RETURN            ; Return to caller
  456.     ENDIF
  457.  
  458.     FIND S9(0:0) "<"                ; Test for comment line
  459.     IF FOUND GOTO Logon_Loop    ; IF "<" found,
  460.  
  461.     SWITCH S1            ; Test ID/Password
  462.     CASE S9(0:15)        ; .. against record
  463.         GOTO Logon_OK        ; We have a match
  464.        ENDCASE
  465.     ENDSWITCH
  466.     GOTO Logon_Loop         ; Read the next record
  467. ;
  468. ;    We have a successful logon
  469. ;
  470. Logon_OK:
  471.     SET FLAG(1) OFF         ; Default no privilege
  472.     SET FLAG(3)ON            ; Set flag to say 'logged-on'
  473.     N0 = 60             ; Set time limit for non-privileged user
  474.  
  475.     FIND S9(16:16) "P"              ; Test for privilege
  476.     IF FOUND            ; IF "P" found,
  477.        SET FLAG(1) ON        ; Indicate privilege
  478.     N0 = 3000            ; 50 hours ought to be enough
  479.     ENDIF
  480.  
  481.     TIME S6 1            ; Set time of logon (military fmt)
  482.  
  483.     FCLOSEI             ; CLose the input file
  484.     SET FLAG(0) OFF         ; Indicate successful logon
  485.     RETURN
  486. ; -----------------------------------------------------------------------
  487. ;    Subroutine: DispFile: Display a file
  488. ;
  489. ;    On entry:
  490. ;    S8 -> The file to be opened (and displayed)
  491. ;    S9 -> A message to be displayed if the file D.N.E
  492. ; -----------------------------------------------------------------------
  493. ;
  494. Disp_File:
  495.     IF ISFILES8            ; If File exists
  496.      TRAN "^M^J"                  ; Send an initial delimiter
  497.        SENDFILEASCIIS8        ; Send the file
  498.        RETURN            ; Return to caller
  499.     ENDIF
  500.  
  501.     IF ISFILES22&"\"*S8            ; If file exists on primary subdir
  502.      TRAN "^M^J"                  ; Send an initial delimiter
  503.        SENDFILEASCIIS22&"\"*S8    ; Send the file
  504.        RETURN            ; Return to caller
  505.     ENDIF
  506.  
  507.     TRAN S9             ; Display the alternative message
  508.     RETURN                ; Return to caller
  509. ; -----------------------------------------------------------------------
  510. ;    Subroutine: Log_Item: Add a line to the activity log
  511. ;
  512. ;    On entry:
  513. ;    S9 -> The line to be added
  514. ;
  515. ;    S7 is used as a scratch reg; S9 is modified
  516. ; -----------------------------------------------------------------------
  517. ;
  518. Log_Item:
  519.     FOPENOS22&"\BBS-LOG" TEXT APPEND ; OPEN file for output
  520.     IF FAILED RETURN        ; If open failed, rtn here
  521.  
  522.     DATE S7             ; Get current date
  523.     CONCAT S9(59) S7        ; Add date to S9 line
  524.     TIME S7 1            ; Get current time (military fmt)
  525.     CONCAT S9(70) S7        ; Add time to S9 line
  526.  
  527.     WRITE S9            ; Write a record     * COM-AND
  528.     WRITE "^M"                      ; Write a cr/lf          * COM-AND
  529.     FCLOSEO             ; CLose the output file
  530.     RETURN                ; And we're done
  531. ;
  532. ; -----------------------------------------------------------------------
  533. ;    Subroutine: Copy text to an open file (write a message)
  534. ;    The output file must be opened by the caller
  535. ;
  536. ;    S9, N18 are used as scratch
  537. ;    N20 carries the current linenum (and must be preserved on GOSUBs)
  538. ; -----------------------------------------------------------------------
  539. ;
  540. Copy_Text:
  541.     N20 = 0
  542. ;
  543. ;    Prompt with a line number, and read a line of text in response
  544. ;
  545. Copy_Loop:
  546.     INC N20             ; Increment line counter
  547.     S9 = N20 & ":  ^H"              ; Convert to decimal ascii
  548.     TRAN S9             ; Transmit line number
  549.  
  550.     GOSUB Read_Comm         ; Read a response
  551.     IF FLAG(0) RETURN        ; If error, make end of text
  552. ;
  553. ;    If the line is not blank, copy it to the output file
  554. ;
  555.     LENGTH S9 N18            ; Get proper length
  556.     IF NOT ZERO N18         ; Test for an empty line
  557.     PRESERVE S9            ; Preserve "!"s and "^"s
  558.      WRITE S9            ; Write the line     * COM-AND
  559.     IF FAILED            ; if write failed
  560.           TRAN "Error recording text - please try later^M^J"
  561.           RETURN            ; Return to caller
  562.     ENDIF
  563.      WRITE  "!"                   ; And a record delimiter * COM-AND
  564.     GOTO Copy_Loop        ; And loop
  565. ;
  566. ;    A blank line was entered - ask if we are to terminate
  567. ;
  568.     ELSE
  569.      TRAN "^M^JComplete? (Y/N, cr=n): "  ; Ask if this is end of input
  570.      GOSUB Read_Comm        ; Read a response
  571.     IF FLAG(0) RETURN        ; If error - disconn
  572.     IF NOT FIND S9 "Y"           ; Test for positive response
  573.     WRITE "!"                 ; Write a blank line
  574.         GOTO Copy_Loop        ; COntinue copying
  575.     ENDIF
  576.      ENDIF
  577.     RETURN                ; Return - we're done
  578. ; -----------------------------------------------------------------------
  579. ; ----- Begin ... reset values, and set the modem to accept a call
  580. ; -----------------------------------------------------------------------
  581. ;
  582. Restart:
  583.     CHDIRS22            ; Reset to default drive
  584.     SET RECHO OFF            ; Turn off echo for us
  585.     SET RDISP OFF            ; Turn on display of received chars
  586.     CLEAR                ; Clear screen
  587.     LOCATE 0,0            ; Set to home
  588.  
  589.     SET FLAG(1) OFF         ; Turn off privilege flag
  590.     SET FLAG(2) OFF         ; Turn off CHDIRflag
  591.     SET FLAG(3)OFF         ; Turn off logged-onflag
  592. ;
  593. ;    Go into auto answer (echo off, answer on3rd)
  594. ;    Also: Return result codes, word form, with CONNECT 1200
  595. ;
  596.     HANGUP                ; HANGUP and leave modem in cmd mode
  597.     MESSAGE "^M^JWaiting..."
  598.     PAUSE 3             ; Wait 3 secs
  599.     SET BAUD S20(5:8)        ; Starting speed
  600.     TRANSMIT S21            ; Transmit modem initialization
  601. ;
  602. ; -----------------------------------------------------------------------
  603. ; ----- Wait for a connect
  604. ; -----------------------------------------------------------------------
  605. ;
  606. Wait_Connect:
  607.     RGET S9 80 180            ; Wait for a line
  608.     IF FAILEDGOTO Wait_Connect    ; If nothing was read
  609.  
  610.     FIND S9 "NO CARRIER"            ; Look for a disconn
  611.     IF FOUND GOTO Restart
  612.  
  613.     FIND S9 "CONNECT"               ; Anything else BUT CONNECT
  614.     IF NOT FOUND GOTO Wait_Connect    ; .. waits
  615. ;
  616. ; ----- Connection established: Adjust our linespeed if need be
  617. ;
  618.     GOSUB AutoBaud            ; Change rate according to CONNECT MSG
  619. ;
  620. ; ----- Issue a greeting
  621. ;
  622.     PAUSE 3             ; Let the modem settle
  623.     RFLUSH                ; Clear line
  624.  
  625.     SET RECHO ON            ; Turn on echo (echo back to caller)
  626.     SET RDISP ON            ; Turn on display of received chars
  627.     PAUSE 1             ; MOdem settling
  628.  
  629.     S9 = "^M^JThe Flying Scotsman greets you!! ^M^J"
  630.     S8 = "BBS-Welc"                 ; Set file name
  631.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  632.  
  633.     N10 = 0             ; Set count of logon tries
  634. ;
  635. ; ----- Request an ID
  636. ;
  637. ID_Query:
  638.     MESS "^M^JID prompt: "          ; Local console indicator
  639.     TRANSMIT "^M^JEnter your ID (or enter GUEST): "
  640.     GOSUB Read_Comm         ; Read into S9
  641.     IF FLAG(0) GOTO Exit        ; If first flag rtns set disconn
  642.  
  643.     IF NULL S9            ; Test for nothing entered
  644.     INC N10            ; Count it as a logon try
  645.     IF GE N10 3GOTO Logon_Fail    ; If tried 3times to logon quit
  646.     GOTO ID_Query        ; Require an ID
  647.      ENDIF            ; End of empty test
  648.  
  649.     SWITCH S9
  650.     CASE "GUEST"                 ; Test for nothing entered
  651.     GOSUB Register        ; Try to register the caller
  652.         GOTO Exit         ; And exit the sequence
  653.        ENDCASE            ; End of GUEST test
  654.     ENDSWITCH            ; End of ID test
  655.     S1 = S9(0:7)            ; Save 8 chars of ID
  656.     UPPERS1            ; Make ID upper case
  657. ;
  658. ; ----- Request a password
  659. ;
  660. Password_Query:
  661.     TRANSMIT "^M^JEnter your password: "
  662.     SET RECHO OFF            ; Turn of echo of received text
  663.     SET RDISPLAY OFF        ; Turn off echo to console too
  664.  
  665.     GOSUB Read_Comm         ; Read into S9
  666.     SET RECHO ON            ; Restore echo
  667.     IF FLAG(0) GOTO Exit        ; If first flag rtns set disconn
  668.     SET RDISPLAY ON         ; Turn on echo to console again
  669.  
  670.     IF NULL S9            ; Test for nothing entered
  671.     INC N10            ; Count it as a logon try
  672.     IF GE N10 3GOTO Logon_Fail    ; If tried 3times to logon quit
  673.     GOTO Password_Query        ; Require a password
  674.      ENDIF            ; End of empty test
  675. ;
  676. ;    Build the ID/password string and test logon
  677. ;
  678.     S1(8:79) = S9(0:7)        ; Add password to S1
  679.     GOSUB Logon            ; Test logon
  680.     IF NOT FLAG(0)            ; If flag(0) returns reset, its ok
  681.        S9 = "Logon: "*S1(0:7)       ; Set activity
  682.      GOSUB Log_Item        ; Add S9 to BBS-LOG
  683.        SET FLAG(2) OFF        ; Indicate no CHDIRthis user
  684.        S1 = S1(0:7)         ; Throw away password
  685.      CLOG "* BBS logon: "*S1
  686.      TRAN "^M^J"                  ; Space one line fror caller
  687.        GOTO Main_Prompt        ; OK - we're on
  688.     ENDIF
  689. ;
  690. ;    Unrecognized ID/password
  691. ;
  692. Logon_Fail:
  693.     TRAN "Unrecognized ID/Password^M^J"
  694.     INC N10             ; Increment count of tries
  695.     IF GE N10 3            ; If tried 3times to logon
  696.      TRAN "You have exceeded the number of tries allowed for logon^M^JBye...^M^J"
  697.        MESS "^M^JLogon attempts failed^M^J"
  698.        S9 = "Failed logon"          ; Report to log
  699.      GOSUB Log_Item
  700.        GOTO Exit            ; ANd hangup
  701.      ENDIF
  702.     GOTO ID_Query            ; And try again
  703. ; -----------------------------------------------------------------------
  704. ; ----- Main Loop: Prompt for a command and interpret the return
  705. ; -----------------------------------------------------------------------
  706. ;
  707. Main_Prompt:
  708.     MESS "^M^JMain prompt: "        ; Local console indicator
  709.     GOSUB Display_Limit        ; Report amount of time remaining
  710.  
  711.     IF NOT FLAG(1)            ; According to privilege
  712.     S9 = "^M^JC)omment, B)ulletins, M)ail, F)iles, A)larm or E)xit: "
  713.     S8 = "BBS-NpMn"              ; Set file name
  714.     ELSE
  715.      S9 = "^M^JP)rivileged, C)omment, B)ulletins, M)ail, F)iles, A)larm or E)xit: "
  716.     S8 = "BBS-PrMn"              ; Set file name
  717.      ENDIF
  718.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  719. ;
  720. ;    Keep just the first char entered
  721. ;
  722.     GOSUB Read_Comm         ; Read into S9
  723.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  724.  
  725.     LJ S9                ; Left justify S9
  726.     S9 = S9(0:0)            ; Keep just the first char
  727. ;
  728. ;    Perform commands
  729. ;
  730.     SWITCH S9            ; Test the entry
  731.     ;
  732.     ;    Alarm
  733.     ;
  734.     CASE "A"                     ; Signal request for chat mode
  735.         GOTO Alarm
  736.        ENDCASE
  737.     ;
  738.     ;    Mail
  739.     ;
  740.     CASE "M"                     ; Messages
  741.      GOTO Mail_Command
  742.        ENDCASE
  743.     ;
  744.     ;    Files command
  745.     ;
  746.     CASE "F"                     ; Files
  747.      GOTO File_Command
  748.        ENDCASE
  749.     ;
  750.     ;    Comment command
  751.     ;
  752.     CASE "C"                     ; Leave a note
  753.         GOTO Comment
  754.        ENDCASE
  755.     ;
  756.     ;    Bulletin command
  757.     ;
  758.     CASE "B"                     ; Read bulletins
  759.         GOTO Bull_Command
  760.        ENDCASE
  761.     ;
  762.     ;    Exit command
  763.     ;
  764.     CASE "E"                     ; Exit
  765.         GOTO Logoff        ; Transmit acknowlegement and Exit
  766.        ENDCASE
  767.     ;
  768.     ;    Privileged command
  769.     ;
  770.     CASE "P"                     ; Privilege
  771.         IF FLAG(1) GOTO Priv_Prompt; Execute only if privileged
  772.        ENDCASE
  773.     ENDSWITCH
  774. ;
  775. ;    Invalid command
  776. ;
  777.     TRAN "^M^JCommand not recognized... try again^M^J"
  778.     GOTO Main_Prompt
  779. ;
  780. ; -----------------------------------------------------------------------
  781. ;    Logoff
  782. ; -----------------------------------------------------------------------
  783. ;
  784. Logoff:
  785.     CHDIRS22            ; Set to our subdirectory
  786.     TRAN "^M^JOK... Bye^M^J"        ; Say g'bye and fall thru to Exit
  787.     S9 = "Logoff: "*S1(0:7)         ; Set activity
  788.     CLOG S9             ; Log here too
  789.     GOSUB Log_Item            ; Add S9 to BBS-LOG
  790. ;
  791. ; -----------------------------------------------------------------------
  792. ;    General exit routine - don't GOTO from within a subroutine!!!
  793. ; -----------------------------------------------------------------------
  794. ;
  795. Exit:
  796.     S9 = "* BBS cycled"             ; Set activity
  797.     CLOG S9             ; Call log it too
  798.     GOSUB Log_Item            ; Add S9 to BBS-LOG
  799.     MESS "^G"                       ; Beep console to indicate exit
  800.     GOTO Restart            ; And start over
  801. ;
  802. ; -----------------------------------------------------------------------
  803. ;    Alarm routine - make some noise, in hopes we can upset somebody
  804. ; -----------------------------------------------------------------------
  805. ;
  806. Alarm:
  807.     SOUND 440 500            ; 1/2 secScale in 'A'
  808.     SOUND 493 100            ; 1/10 sec
  809.     SOUND 554 100            ; 1/10 sec
  810.     SOUND 587 100            ; 1/10 sec
  811.     SOUND 659 100            ; 1/10 sec
  812.     SOUND 739 100            ; 1/10 sec
  813.     SOUND 830 100            ; 1/10 sec
  814.     SOUND 880 500            ; 1/2 sec
  815.     GOTO Main_Prompt        ; And start over
  816. ; -----------------------------------------------------------------------
  817. ; ----- Privileged commands submenu.
  818. ; -----------------------------------------------------------------------
  819. ;
  820. Priv_Prompt:
  821.     MESS "^M^JPrivilege prompt: "   ; Local console indicator
  822.     GOSUB Display_Limit        ; Report amount of time remaining
  823.     S9 = "^M^JL)ist, P)ath, S)ubdir, D)OS, M)ain or E)xit: "
  824.     S8 = "BBS-PPMn"                 ; Set file name
  825.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  826. ;
  827. ;    Keep just the first char entered
  828. ;
  829.     GOSUB Read_Comm         ; Read into S9
  830.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  831.  
  832.     LJ S9                ; Left justify S9
  833.     S9 = S9(0:0)            ; Keep just the first char
  834. ;
  835. ;    Execute a command
  836. ;
  837.     SWITCH S9            ; Test the entry
  838.     ;
  839.     ;    List command
  840.     ;
  841.     CASE "L"                     ; List
  842.         GOTO DIR
  843.        ENDCASE
  844.     ;
  845.     ;    Subdir command
  846.     ;
  847.     CASE "S"                     ; Chdir
  848.         GOTO CHDIR
  849.        ENDCASE
  850.     ;
  851.     ;    Pathlist command
  852.     ;
  853.     CASE "P"                     ; Pathlist
  854.         GOTO PATHLIST
  855.        ENDCASE
  856.     ;
  857.     ;    Shell command
  858.     ;
  859.     CASE "D"                     ; Shell
  860.         GOTO Shell
  861.        ENDCASE
  862.     ;
  863.     ;    Main command
  864.     ;
  865.     CASE "M"                     ; Go back to main prompt
  866.      GOTO Main_Prompt
  867.        ENDCASE
  868.     ;
  869.     ;    Exit command
  870.     ;
  871.     CASE "E"                     ; Exit
  872.         GOTO Logoff        ; Transmit acknowlegement and Exit
  873.        ENDCASE
  874.     ENDSWITCH
  875. ;
  876. ;    Invalid command
  877. ;
  878.     TRAN "^M^JCommand not recognized... try again^M^J"
  879.     GOTO Priv_Prompt
  880. ; -----------------------------------------------------------------------
  881. ;    Privileged user: CHDIR... Query for a path.
  882. ; -----------------------------------------------------------------------
  883. ;
  884. CHDIR:
  885.     MESS "^M^JCHDIRCommand: "      ; Local console indicator
  886.     TRAN "^M^JEnter the drive:subdirectory: "
  887.  
  888.     GOSUB Read_Comm         ; Read into S9
  889.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  890.  
  891.     IF NOT NULL S9            ; If something entered
  892.     CHDIRS9            ; Do it.
  893.        SET FLAG(2) ON        ; Save the fact we've done a CHDIR
  894.        ENDIF
  895.     GOTO Priv_Prompt        ; And continue
  896. ; -----------------------------------------------------------------------
  897. ;    Privileged user: Path tree... awkward... but it works
  898. ; -----------------------------------------------------------------------
  899. ;
  900. PATHLIST:
  901.     MESS "^M^JPathlist command: "   ; Local console indicator
  902.     TRAN "^M^JWorking..."           ; May take a moment
  903.  
  904.     DOS "TREED >\HOSTTEMP.TXT"      ; To a temp file
  905.  
  906.     TRAN "^M^JUse control-S to suspend, control-Q to continue^M^J"
  907.     SENDFILE ASCII "\HOSTTEMP.TXT"
  908.     TRAN "^M^J"                     ; Send a c/r
  909.  
  910.     DELETE "\HOSTTEMP.TXT"          ; Clean up after us
  911.     GOTO Priv_Prompt        ; And continue
  912. ; -----------------------------------------------------------------------
  913. ;    Privileged user: DOS SHELL... Query for a command
  914. ; -----------------------------------------------------------------------
  915. ;
  916. Shell:
  917.     MESS "^M^JDOS Command: "        ; Local console indicator
  918.     TRAN "^M^JWarning:this command may be used to invoke ANY COMMAND that"
  919.     TRAN "^M^JDOS can execute.If you load a program requiring keyboard  "
  920.     TRAN "^M^Jentry, you lock yourself out and leave the board unusable."
  921.     TRAN "^M^J"
  922.     TRAN "^M^JEnter your command: "
  923.  
  924.     GOSUB Read_Comm         ; Read into S9
  925.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  926.  
  927.     IF NULL S9            ; If nothing entered
  928.     GOTO Priv_Prompt        ; User decided better
  929.        ENDIF
  930.  
  931.     IF FIND S9 "FORMAT"             ; Disallow any format commands
  932.      TRAN "^M^JFormat commands are not allowed..."
  933.     GOTO Priv_Prompt        ; And continue
  934.     ENDIF
  935. ;
  936. ;    Perform it
  937. ;
  938.     TRAN "^M^JWorking..."           ; May take a moment
  939.  
  940.     CONCAT S9 ">\HOSTTEMP.TXT"
  941.     DOS S9            ; Do it.
  942.  
  943.     TRAN "^M^JUse control-S to suspend, control-Q to continue^M^J"
  944.     SENDFILE ASCII "\HOSTTEMP.TXT"
  945.     TRAN "^M^J"                     ; Send a c/r
  946.  
  947.     DELETE "\HOSTTEMP.TXT"          ; Clean up after us
  948.     GOTO Priv_Prompt        ; And continue
  949. ; -----------------------------------------------------------------------
  950. ;    Directory list... awkward... but it works
  951. ; -----------------------------------------------------------------------
  952. ;
  953. Dir:
  954.     MESS "^M^JDirectory command: "  ; Local console indicator
  955.     TRAN "^M^JWorking..."           ; May take a moment
  956.  
  957.     DOS "DIR>\HOSTTEMP.TXT"        ; To a temp file
  958.     TRAN "^M^JUse control-S to suspend, control-Q to continue^M^J"
  959.     SENDFILE ASCII "\HOSTTEMP.TXT"
  960.     TRAN "^M^J"                     ; Send a c/r
  961.  
  962.     DELETE "\HOSTTEMP.TXT"          ; Clean up after us
  963.     GOTO Priv_Prompt        ; And continue
  964. ; -----------------------------------------------------------------------
  965. ;    Files command: File list, Upload, download or back to main
  966. ;
  967. ;    Note: S19 must be retained throughout this submenu...
  968. ;        It is used to save the current subdir
  969. ; -----------------------------------------------------------------------
  970. ;
  971. File_Command:
  972.     MESS "^M^JFile prompt: "        ; Local console indicator
  973.     SUBDIRS19            ; Save current subdir
  974.     CHDIRS23            ; Set to default subdir
  975. ;
  976. ;    Prompt for a command
  977. ;
  978. File_Prompt:
  979.     GOSUB Display_Limit        ; Report amount of time remaining
  980.     S9 = "^M^JL)ist, S)earch, U)pload, D)ownload, M)ain or E)xit: "
  981.     S8 = "BBS-FiMe"                 ; Set file name
  982.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  983. ;
  984. ;    Keep just the first char entered
  985. ;
  986.     GOSUB Read_Comm         ; Read into S9
  987.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  988.  
  989.     LJ S9                ; Left justify S9
  990.     S9 = S9(0:0)            ; Keep just the first char
  991. ;
  992. ;    Interpret the command
  993. ;
  994.     SWITCH S9            ; Test the entry
  995.     ;
  996.     ;    Download command
  997.     ;
  998.     CASE "D"                     ; Download
  999.         GOTO DOWNLOAD
  1000.        ENDCASE
  1001.     ;
  1002.     ;    Upload command
  1003.     ;
  1004.     CASE "U"                     ; Upload
  1005.         GOTO UPLOAD
  1006.        ENDCASE
  1007.     ;
  1008.     ;    List command
  1009.     ;
  1010.     CASE "L"                     ; File list
  1011.      GOTO FILELIST
  1012.        ENDCASE
  1013.     ;
  1014.     ;    Search command
  1015.     ;
  1016.     CASE "S"                     ; Search list
  1017.      GOTO Search
  1018.        ENDCASE
  1019.     ;
  1020.     ;    Main command
  1021.     ;
  1022.     CASE "M"                     ; Go back to main prompt
  1023.      CHDIRS19         ; Reset subdir
  1024.           GOTO Main_Prompt
  1025.        ENDCASE
  1026.     ;
  1027.     ;    Exit command
  1028.     ;
  1029.     CASE "E"                     ; Exit
  1030.         GOTO Logoff        ; Transmit acknowlegement and Exit
  1031.        ENDCASE
  1032.     ENDSWITCH
  1033.  
  1034.     TRAN "Invalid selection - try again^M^J"
  1035.     GOTO FILE_Prompt
  1036. ; -----------------------------------------------------------------------
  1037. ;    Subroutine: Query for a file name - return in S8
  1038. ;    On exit:
  1039. ;       FLAG(0) Returned ON to indicate caller disconn/timedout
  1040. ; -----------------------------------------------------------------------
  1041. ;
  1042. File_Query:
  1043.     MESS "^M^JFname query: "        ; Local console indicator
  1044.     TRAN "^M^JEnter the file name: "
  1045.  
  1046.     GOSUB Read_Comm         ; Read into S9
  1047.     RETURN                ; Return to caller (w/flag(0) set)
  1048. ;
  1049. ; -----------------------------------------------------------------------
  1050. ;    XMODEM Upload (up from caller)
  1051. ;
  1052. ;    Files unqualified by drive:subdir are placed in the default
  1053. ;    DLOAD subdirectory.
  1054. ;
  1055. ;    Note: Qualified names (containing subdir) are permitted
  1056. ;        only if the privilege flag (FLAG(1)) is set.
  1057. ; -----------------------------------------------------------------------
  1058. ;
  1059. UPLOAD:
  1060.     MESS "^M^JUpload from caller "
  1061.  
  1062.     GOSUB File_Query        ; Ask for a file name
  1063.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1064.  
  1065.     IF NULL S9            ; If no file returned
  1066.     GOTO File_Prompt        ; .. start over
  1067.     ENDIF            ; ..
  1068.  
  1069.     IF FIND S9 "\" and NOT FLAG(1)  ; Test for subdir in name and privilege
  1070.      TRAN "^M^JQualified file names are not permitted."
  1071.     GOTO UPLOAD            ; Ask again
  1072.        ENDIF
  1073.  
  1074.     IF ISDLFILE S9            ; If file exists in DL subdir
  1075.        TRAN "^M^JFile already exists"
  1076.     GOTO UPLOAD            ; Ask again
  1077.        ENDIF
  1078. ;
  1079. ;    Prompt for a method
  1080. ;
  1081.     MESS "^M^JUlo Method prompt: "  ; Local console indicator
  1082.     TRAN "^M^JW)xmodem, X)modem, Y)modem (X1k), Z)modem, or K)ermit: "
  1083.  
  1084.     S8 = S9             ; Save file name
  1085. ;
  1086. ;    Keep just the first char entered
  1087. ;
  1088.     GOSUB Read_Comm         ; Read into S9
  1089.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1090.  
  1091.     LJ S9                ; Left justify S9
  1092.     S9 = S9(0:0)            ; Keep just the first char
  1093. ;
  1094. ;    Interpret the response
  1095. ;
  1096.     TIME S10 1            ; Save start of upload time
  1097.     SWITCH S9            ; Test the entry
  1098.     CASE "W"
  1099.     TRAN "^M^JBegin your transfer procedure..."
  1100.     GETFILE WXMODEM S8
  1101.        ENDCASE
  1102.     CASE "X"
  1103.     TRAN "^M^JBegin your transfer procedure..."
  1104.     GETFILE XMODEM S8
  1105.        ENDCASE
  1106.     CASE "Y"
  1107.     TRAN "^M^JBegin your transfer procedure..."
  1108.     GETFILE YMODEM S8
  1109.        ENDCASE
  1110.     CASE "Z"
  1111.     TRAN "^M^JBegin your transfer procedure..."
  1112.     GETFILE ZMODEM
  1113.        ENDCASE
  1114.     CASE "K"
  1115.     TRAN "^M^JBegin your transfer procedure..."
  1116.     GETFILE KERMIT        ; FIle name supplied by caller
  1117.        ENDCASE
  1118.     DEFAULT
  1119.           TRAN "^M^JInvalid transfer selection"
  1120.     SET SUCCESS OFF
  1121.           GOTO EOTransfer
  1122.        ENDCASE
  1123.     ENDSWITCH
  1124. ;
  1125. ;    Log the transfer
  1126. ;
  1127.     IF FAILED
  1128.        S9 = "Upload ("*S9(0:0)*"): "*S8&", Failure"
  1129.     GOSUB Log_Item        ; Add S9 to BBS-LOG
  1130.     DELETE S8            ; Delete parial file
  1131.     SET SUCCESS OFF        ; Control msg to console
  1132.     GOTO EOTransfer
  1133.     ELSE
  1134.     S9 = "Upload ("*S9(0:0)*"): "*S8&", Success"
  1135.     GOSUB Log_Item        ; Add S9 to BBS-LOG
  1136.     ENDIF
  1137. ;
  1138. ;    A file uploaded with subdirectory doesn't get logged
  1139. ;
  1140.     IF FIND S8 "\"                  ; Test for subdir in name
  1141.     GOTO File_Prompt        ; Skip logging it
  1142.        ENDIF
  1143. ;
  1144. ;    Convert times to numeric quantities
  1145. ;
  1146.     TIME S11 1            ; Get current time (military fmt)
  1147.     N19 = S11(0:1)*60+S11(3:4)    ; Compute current time since midnight
  1148.     N18 = S10(0:1)*60+S10(3:4)    ; Time of upload since midnight
  1149. ;
  1150. ;    Compute the time remaining and add it to the max
  1151. ;
  1152.     IF GT N18 N19            ; If timeout on the RGET
  1153.        N19 = N19+1440        ; Allow wrap accross midnight
  1154.        ENDIF
  1155.     N0 = N0+(N19-N18)        ; Compute time to upload and add it in
  1156. ;
  1157. ;    At this point, ask for a description for the file
  1158. ;
  1159. Describe:
  1160.     TRAN "^M^JDescription: "        ; Prompt
  1161.     GOSUB Read_Comm         ; Read response
  1162.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1163.  
  1164.     IF NULL S9            ; If nothing entered
  1165.     TRAN "^M^JPlease leave something of a description"
  1166.     GOTO Describe        ; Try again
  1167.        ENDIF
  1168. ;
  1169. ;    Open the file list, and append the file
  1170. ;
  1171.     FOPENO "BBS-File"  TEXT APPEND  ; Open the file to append
  1172.     IF FAILED
  1173.        S9 = "Uload of "*S8&" succeeded, but BBS-FIle open failed"
  1174.     GOSUB Log_Item        ; Log it
  1175.        SET SUCCESS OFF        ; Indicate failure for console
  1176.     GOTO EOTransfer        ; If error, exit
  1177.        ENDIF
  1178. ;
  1179. ;    Build a record for BBS-FIle
  1180. ;
  1181.     DATE S0             ; Get the current date
  1182.     S8 = S8 & "            "        ; Ensure blank padding
  1183.     FSIZE S11 S8            ; Get file size using fname
  1184.     S10 = S8(0:11) * S0(0:7) *" "* S11(0:6) * S9
  1185.     WRITE S10            ; write the record
  1186.     WRITE "!"                       ; Write a delimiter
  1187.  
  1188.     FCLOSEO             ; Close the output file
  1189.     SET SUCCESS ON            ; Indicate success
  1190.     GOTO EOTransfer         ; Report success/failure
  1191. ; -----------------------------------------------------------------------
  1192. ;    XMODEM Download (down to caller)
  1193. ;
  1194. ;    Download occurs from the default drive:subdir unless explicitly
  1195. ;    qualified.
  1196. ;
  1197. ;    Note: Qualified names (containing subdir) are permitted
  1198. ;        only if the privilege flag (FLAG(1)) is set.
  1199. ; -----------------------------------------------------------------------
  1200. ;
  1201. DOWNLOAD:
  1202.     MESS "^M^JDownload to caller "
  1203.  
  1204.     GOSUB File_Query        ; Ask for a file name
  1205.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1206.  
  1207.     IF NULL S9GOTO File_Prompt    ; If no file returned, start over
  1208.     IF FIND S9 "\"                  ; Test for subdir
  1209.        IF NOT FLAG(1)        ; Test for privilege
  1210.      TRAN "^M^JQualified file names are not permitted."
  1211.     GOTO DOWNLOAD        ; Ask again
  1212.           ENDIF
  1213.        ENDIF
  1214.  
  1215.     IF NOT ISFILE S9        ; If file doesn't exist
  1216.     GOSUB FileTest        ; Look in BBS-File
  1217.        IF FAILED            ; If not found
  1218.           TRAN "^M^JFile doesn't exist"
  1219.     GOTO DOWNLOAD        ; Ask again
  1220.           ENDIF            ; Else S9 contains file name
  1221.        ENDIF
  1222.     S8 = S9             ; Save file name
  1223. ;
  1224. ;    Prompt for a method
  1225. ;
  1226.     MESS "^M^JDlo Method prompt "
  1227.     TRAN "^M^JW)xmodem, X)modem, Y)modem (X1k), Z)modem, K)ermit, or A)scii: "
  1228. ;
  1229. ;    Keep just the first char entered
  1230. ;
  1231.     GOSUB Read_Comm         ; Read into S9
  1232.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1233.  
  1234.     LJ S9                ; Left justify S9
  1235.     S9 = S9(0:0)            ; Keep just the first char
  1236. ;
  1237. ;    Interpret the response
  1238. ;
  1239.     SWITCH S9            ; Test the entry
  1240.     CASE "A"
  1241.     TRAN "^M^JUse control-S to suspend, control-Q to continue^M^J"
  1242.           SENDFILE ASCII S8
  1243.        ENDCASE
  1244.     CASE "W"
  1245.     TRAN "^M^JBegin your transfer procedure..."
  1246.     SENDFILE WXMODEM S8
  1247.        ENDCASE
  1248.     CASE "X"
  1249.     TRAN "^M^JBegin your transfer procedure..."
  1250.     SENDFILE XMODEM S8
  1251.        ENDCASE
  1252.     CASE "Y"
  1253.     TRAN "^M^JBegin your transfer procedure..."
  1254.     SENDFILE YMODEM S8
  1255.        ENDCASE
  1256.     CASE "Z"
  1257.     TRAN "^M^JBegin your transfer procedure..."
  1258.     SENDFILE ZMODEM S8
  1259.        ENDCASE
  1260.     CASE "K"
  1261.     TRAN "^M^JBegin your transfer procedure..."
  1262.     SENDFILE KERMIT S8
  1263.        ENDCASE
  1264.     DEFAULT
  1265.           TRAN "^M^JInvalid transfer selection"
  1266.       SET SUCCESS OFF        ; Indicate failure for console
  1267.     GOTO EOTransfer
  1268.        ENDCASE
  1269.     ENDSWITCH
  1270. ;
  1271. ;    Log the download
  1272. ;
  1273.     IF FAILED
  1274.        S9 = "Download ("*S9(0:0)*"): "*S8&", Failure"
  1275.     GOSUB Log_Item    ; Add S9 to BBS-LOG
  1276.     SET SUCCESS OFF
  1277.     ELSE
  1278.     S9 = "Download ("*S9(0:0)*"): "*S8&", Success"
  1279.     GOSUB Log_Item        ; Add S9 to BBS-LOG
  1280.     SET SUCCESS ON
  1281.        ENDIF
  1282. ;
  1283. ;    End of transfer... note result on local console
  1284. ;
  1285. EOTransfer:
  1286.     IF FAILED
  1287.        MESS "^M^JTransfer failed "
  1288.     ELSE
  1289.     MESS "^M^JTransfer OK "
  1290.        ENDIF
  1291.     GOTO File_Prompt
  1292. ; -----------------------------------------------------------------------
  1293. ;    FileTest - take qualification for fname from description
  1294. ;    S8 passes the name to use - returned fully qualified
  1295. ; -----------------------------------------------------------------------
  1296. ;
  1297. FileTest:
  1298.     FOPENI "BBS-File"  TEXT         ; Open the mailkey file
  1299.     IF FAILED            ; IF error opening
  1300.       SET SUCCESS OFF        ; Indicate file dne
  1301.     RETURN            ; Rtn to caller
  1302.        ENDIF
  1303.     LJ S9                ; Left justify
  1304. ;
  1305. ;    Read records from BBS-File
  1306. ;
  1307. FTestLoop:
  1308.     READ S0 80 N19            ; Read a record
  1309.     IF EOF GOTO FTestEnd        ; On end of file, report not found
  1310. ;
  1311. ;    With the exception of comments, test for file availability
  1312. ;
  1313.     IF FIND S0(0:0) "*" GOTO FTestLoop  ; Ignore comments simply
  1314.     IF NOT FIND S0(0:11) S9GOTO FTestLoop
  1315.     S2 = S0(0:11)            ; Extract File name
  1316.     IF FIND S0(28:28) "^A"          ; Look for ^A in description
  1317.        IF FIND S0(29:79) "^A" N11   ; .. want a pair...
  1318.       S2 = S0(29:29+N11-1)&"\"*S2   ; Use between as subdir
  1319.           ENDIF
  1320.        ENDIF
  1321.     IF NOT ISFILE S2 GOTO FTestLoop ; If file dosn't exist
  1322. ;
  1323. ;    We have a match...
  1324. ;
  1325.     S9 = S2             ; Rtn file name in S9
  1326.     FCLOSEI             ; Close input file
  1327.     SET SUCCESS ON            ; And indicate success
  1328.     RETURN                ; Rtn to caller
  1329. ;
  1330. ;    End of loop
  1331. ;
  1332. FTestEnd:
  1333.     FCLOSEI             ; CLOSE the keys file
  1334.     SET SUCCESS OFF         ; Indicate not found
  1335.     RETURN                ; Rtn to caller
  1336. ; -----------------------------------------------------------------------
  1337. ;    List command - list file directories
  1338. ; -----------------------------------------------------------------------
  1339. ;
  1340. Filelist:
  1341.     N10 = 0             ; Initialize counter (# records)
  1342.  
  1343.     FOPENI "BBS-File"  TEXT         ; Open the mailkey file
  1344.     IF FAILED            ; IF error opening
  1345.       TRAN "^M^JNo files are available at this time^M^J"
  1346.        GOTO File_Prompt        ; And go back to files mainline
  1347.     ENDIF
  1348. ;
  1349. ;    Read records from BBS-File
  1350. ;
  1351. FListLoop:
  1352.     READ S9 80 N19            ; Read a record
  1353.     IF EOF GOTO FListEnd        ; On end of file, report count found
  1354. ;
  1355. ;    With the exception of comments, test for file availability
  1356. ;
  1357.     IF FIND S9(0:0) "*" GOTO FListPrint ; Print comments simply
  1358.     S0 = S9(0:11)                ; Extract File name
  1359.     IF FIND S9(28:28) "^A"              ; Look for ^A in description
  1360.        IF FIND S9(29:79) "^A" N11       ; .. want a pair...
  1361.       S0 = S9(29:29+N11-1)&"\"*S0   ; Use between as subdir
  1362.           S9(28:79) = S9(29+N11+1:79)   ; Remove from description
  1363.           ENDIF
  1364.        ENDIF
  1365.     IF NOT ISFILE S0 GOTO FListLoop     ; If file dosn't exist
  1366.     IF FIND S9(12:12) "*"               ; If not dated...
  1367.     FDATE S2 S0 1            ; .. get date
  1368.     FSIZE S3 S0                ; .. and size
  1369.     S9(12:19) = S2            ; .. and put into record
  1370.        S9(21:27) = S3            ; For display
  1371.     ENDIF
  1372. ;
  1373. ;    If nothing has been displayed yet, do a heading
  1374. ;
  1375.     IF ZERO N10            ; If no recs displayed yet
  1376.       TRAN "^M^JName         Dated    Size    Description ^M^J"
  1377.        TRAN "------------ -------- ------- ----------------------------------------------^M^J"
  1378.        ENDIF
  1379. ;
  1380. ;    Format the record for printing
  1381. ;
  1382.     S9 = S9(0:11) * " " * S9(12:19) * " " * S9(21:27) * " " * S9(28:79)
  1383. ;
  1384. ;    And display the record
  1385. ;
  1386. FListPrint:
  1387.     TRAN S9             ; Display the record
  1388.     TRAN "^M^J"                     ; And a cr/lf
  1389.     N10 = N10+1            ; COunt this one
  1390.     GOTO FListLoop            ; Loop until EOF
  1391. ;
  1392. ;    End of loop
  1393. ;
  1394. FListEnd:
  1395.     FCLOSEI             ; CLOSE the keys file
  1396.     GOTO File_Prompt        ; And loop until EOF
  1397. ; -----------------------------------------------------------------------
  1398. ;    Search command - search file directory
  1399. ; -----------------------------------------------------------------------
  1400. ;
  1401. Search:
  1402.     TRAN "^M^JEnter the search string: "
  1403.     GOSUB Read_Comm         ; Read response
  1404.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1405.  
  1406.     IF NULL S9GOTO File_Prompt    ; If blank response exit
  1407.     S18 = S9            ; Save search string
  1408. ;
  1409. ;    Open the directory for searching
  1410. ;
  1411.     FOPENI "BBS-File"  TEXT         ; Open the mailkey file
  1412.     IF FAILED            ; IF error opening
  1413.       TRAN "^M^JNo files are available at this time^M^J"
  1414.        GOTO File_Prompt        ; And go back to mainline
  1415.     ENDIF
  1416.     N10 = 0             ; Initialize counter (# records)
  1417. ;
  1418. ;    Read a record
  1419. ;
  1420. Search_Loop:
  1421.     READ S9 80 N19            ; Read a record
  1422.     IF EOF GOTO Search_End        ; On end of file, Skip
  1423. ;
  1424. ;    With the exception of comments, test for file availability
  1425. ;
  1426.     IF FIND S9(0:0) "*" GOTO Search_Loop ; Always skip comments
  1427.     S0 = S9(0:11)            ; Extract File name
  1428.     IF FIND S9(28:28) "^A"              ; Look for ^A in description
  1429.        IF FIND S9(29:79) "^A" N11       ; .. want a pair...
  1430.       S0 = S9(29:29+N11-1)&"\"*S0   ; Use between as subdir
  1431.           S9(28:79) = S9(29+N11+1:79)   ; Remove from description
  1432.           ENDIF
  1433.        ENDIF
  1434.     IF NOT ISFILE S0 GOTO Search_Loop   ; If file dosn't exist
  1435.     IF FIND S9(12:12) "*"               ; If not dated...
  1436.     FDATE S2 S0 1            ; .. get date
  1437.     FSIZE S3 S0                ; .. and size
  1438.     S9(12:19) = S2            ; .. and put into record
  1439.        S9(21:27) = S3            ; For display
  1440.     ENDIF
  1441. ;
  1442. ;    Test for target string in record
  1443. ;
  1444.     IF NOT FIND S9 S18 GOTO Search_Loop
  1445. ;
  1446. ;    If nothing has been displayed yet, do a heading
  1447. ;
  1448.     IF ZERO N10            ; If no recs displayed yet
  1449.       TRAN "^M^JName         Dated    Size    Description ^M^J"
  1450.        TRAN "------------ -------- ------- ----------------------------------------------^M^J"
  1451.        ENDIF
  1452. ;
  1453. ;    Format the record for printing
  1454. ;
  1455.     S0 = S9(0:11) * " " * S9(12:19) * " " * S9(21:27) * " " * S9(28:79)
  1456.     TRAN S0             ; Display the record
  1457.     TRAN "^M^J"                     ; And a cr/lf
  1458.     N10 = N10+1            ; COunt this one
  1459.     GOTO Search_Loop        ; Loop until EOF
  1460. ;
  1461. ;    End of loop
  1462. ;
  1463. Search_End:
  1464.     IF ZERO N10            ; If nothing found...
  1465.     TRAN "^M^JNo matches"        ; Indicate it
  1466.        ENDIF
  1467.  
  1468.     FCLOSEI             ; CLOSE the keys file
  1469.     GOTO File_Prompt        ; And loop until EOF
  1470. ; -----------------------------------------------------------------------
  1471. ;    Leave a comment (branched to - "Main_Prompt")
  1472. ;
  1473. ;    This routine executes out of the defined BBS subdir, no matter
  1474. ;    what subdir a privileged user has selected.  It saves the current
  1475. ;    subdir and restores it upon completion.
  1476. ;
  1477. ;    Note: S19 must be retained throughout this submenu...
  1478. ;          It is used to save the current subdir
  1479. ; -----------------------------------------------------------------------
  1480. ;
  1481. Comment:
  1482.     SUBDIR S19            ; Save current subdir
  1483.     CHDIR S22            ; Reset current subdir
  1484.  
  1485.     MESS "^M^JComment requested "
  1486.     S9 = "Do you wish to leave a comment? (Y/N, cr=n): "
  1487.     S8 = "BBS-NoMe"                 ; Set file name
  1488.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  1489.  
  1490.     GOSUB Read_Comm         ; Read a response
  1491.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1492.  
  1493.     FIND S9 "Y"                     ; Look for "Y"
  1494.     IF NOT FOUND            ; IF answer wan't 'Y'
  1495.     TRAN "OK"                    ; Odd character
  1496.        CHDIR S19            ; Reset default subdir
  1497.        GOTO Main_Prompt        ; We're done.
  1498.     ENDIF
  1499. ;
  1500. ;    Open the comments file
  1501. ;
  1502.     FOPENO "BBS-Note" TEXT APPEND ; OPEN file for input
  1503.     IF FAILED            ; if open failed
  1504.     TRAN "Error recording note - please try later^M^J"
  1505.        CHDIR S19            ; Reset default subdir
  1506.        GOTO Main_Prompt        ; GOTO Main_Prompt to caller
  1507.        ENDIF
  1508.  
  1509.     S9 = "*** Note left by "
  1510.     CONCAT S9(17) S1        ; Add User ID
  1511.     DATE S8
  1512.     CONCAT S9(25) S8(0:9)        ; Add date
  1513.     TIME S8 1            ; (military fmt)
  1514.     CONCAT S9(35) S8(0:7)        ; Add time
  1515.     WRITE S9            ; Write header to file     * COM-AND
  1516.     WRITE "!"                       ; Write a record delim   * COM-AND
  1517. ;
  1518. ;    Ask for lines, and write them to the output file
  1519. ;
  1520.     TRAN "Each line, as you enter it will be recorded.  No edits, yet...^M^J"
  1521.     TRAN "Enter a line/line(s) of text.  A blank line ends the note.^M^J"
  1522.     GOSUB Copy_Text         ; Note FLAG(0) test below
  1523. ;
  1524. ;    We have a blank line - and the end of a note
  1525. ;
  1526.     WRITE "------------!"           ; Write a delimiter
  1527.     FCLOSEO             ; CLose the file
  1528.     IF FLAG(0) GOTO Exit        ; If COPY_Text rtns flag set, disconn
  1529.     TRAN "Your note has been recorded - thanks^M^J"
  1530. ;
  1531. ;    Log the fact, cleanup and we're done
  1532. ;
  1533.     S9 = "Comment recorded"
  1534.     GOSUB Log_Item            ; Write to BBS-Log
  1535.  
  1536.     CHDIR S19            ; Reset default subdir
  1537.     GOTO Main_Prompt        ; GO for next cmd
  1538. ; -----------------------------------------------------------------------
  1539. ;    Bulletin command: List, and read a specific item
  1540. ;
  1541. ;    The BBS-BULL file is structured:
  1542. ;    0      5        13 14     26
  1543. ;    +---/ /---+---/ /---+--+---/ /---+-------/ /--------+
  1544. ;    ! Number  ! Date    !  ! Fname     ! Subject (40 char)!
  1545. ;    +---/ /---+---/ /---+--+---/ /---+-------/ /--------+
  1546. ;                 ^ Privileged user bulletin flag
  1547. ;
  1548. ;    Note: S19 must be retained throughout this submenu...
  1549. ;          It is used to save the current subdir
  1550. ; -----------------------------------------------------------------------
  1551. ;
  1552. Bull_Command:
  1553.     SUBDIR S19            ; Save current subdir
  1554.     CHDIR S25            ; Switch to Bulletins subdir
  1555. ;
  1556. ;    Restart (perform a list command) at this point
  1557. ;
  1558. BULL_List:
  1559.     MESS "^M^JBulletin list: "      ; Local console indicator
  1560.     N10 = 0             ; Initialize a counter
  1561.  
  1562.     FOPENI "BBS-Bull"  TEXT         ; Open the bulletin file
  1563.     IF FAILED            ; IF error opening
  1564.       TRAN "^M^JNo bulletins exist^M^J"
  1565.        CHDIR S19            ; Return to default subdir
  1566.        GOTO Main_Prompt        ; And go back to mainline
  1567.     ENDIF
  1568. ;
  1569. ;    Read a record
  1570. ;
  1571. Bull_Loop:
  1572.     READ S9 80 N19            ; Read a record
  1573.     IF EOF GOTO Bull_Prompt     ; Test for end of file
  1574.     IF NOT NULL S9(13:13)        ; Test privilege flag
  1575.        IF NOT FLAG(1) GOTO Bull_Loop; Only display if privileged user
  1576.     ENDIF
  1577. ;
  1578. ;    With the exception of comments, test for file availability
  1579. ;
  1580.     IF FIND S9(0:0) "*" GOTO Bull_Loop ; Skip comments
  1581.  
  1582.     S0 = S9(14:25)            ; Extract File name
  1583.     IF NOT ISFILE S0 GOTO Bull_Loop ; If file dosn't exist
  1584. ;
  1585. ;    If nothing has been displayed yet, do a heading
  1586. ;
  1587.     IF ZERO N10            ; If no recs displayed yet
  1588.       TRAN "^M^JNum   Dated    Subject^M^J"
  1589.        TRAN "----- -------- -------------------------------------------------------------^M^J"
  1590.        ENDIF
  1591. ;
  1592. ;    And display the record
  1593. ;
  1594.     S0 = S9(0:4)*" "*S9(5:12)*" "*S9(26:79)
  1595.     TRAN S0             ; Display the record
  1596.     TRAN "^M^J"                     ; And a cr/lf
  1597.     N10 = N10+1            ; COunt this one
  1598.     GOTO Bull_Loop            ; Loop until EOF
  1599. ;
  1600. ;    End of loop:  prompt for a bulletin number
  1601. ;
  1602. Bull_Prompt:
  1603.     FCLOSEI             ; CLose the input file
  1604.     GOSUB Display_Limit        ; Report amount of time remaining
  1605.     S9 = "^M^JL)ist, M)ain, E)xit, or a bulletin number: "
  1606.     S8 = "BBS-BuMe"                 ; Set file name
  1607.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  1608. ;
  1609. ;    Read a response
  1610. ;
  1611.     GOSUB Read_Comm         ; Read into S9
  1612.     IF FLAG(0) GOTO Exit        ; If first flag rtns set disconn and restart
  1613. ;
  1614. ;    Test for alpha commands
  1615. ;
  1616.     LJ S9                ; Left justify S9
  1617.     IF FIND S9(0:0) "L"             ; If command was List
  1618.        GOTO Bull_List        ; Perform the list again
  1619.        ENDIF
  1620.  
  1621.     IF FIND S9(0:0) "M"             ; If command was Main
  1622.        CHDIR S19            ; Return to default subdir
  1623.        GOTO Main_Prompt        ; Go back to main
  1624.        ENDIF
  1625.  
  1626.     IF FIND S9(0:0) "E"             ; If command was Exit
  1627.        GOTO Logoff            ; Transmit acknowlegement and Exit
  1628.        ENDIF
  1629. ;
  1630. ;    We're going to scan the keys file for the input
  1631. ;
  1632.     FOPENI "BBS-Bull"  TEXT         ; Open the bulletin file
  1633.     IF FAILED            ; IF error opening
  1634.       TRAN "^M^JNo bulletins available^M^J"
  1635.        CHDIR S19            ; Return to default subdir
  1636.        GOTO Main_Prompt        ; And go back to mainline
  1637.     ENDIF
  1638.     S0 = S9             ; Save response in S0
  1639. ;
  1640. ;    Read a record from BBS-Bull
  1641. ;
  1642. Bull_Scan:
  1643.     READ S9 80 N19            ; Read a record
  1644.     IF EOF                ; Test for end of file
  1645.       TRAN "^M^JNo such bulletin!! ^M^J"
  1646.        FCLOSEI            ; CLose input file
  1647.        GOTO Bull_Prompt        ; Select one specific
  1648.        ENDIF
  1649.  
  1650.     IF FIND S9(0:0) "*" GOTO Bull_Scan; Throw away comments
  1651.  
  1652.     IF NOT NULL S9(13:13)        ; Test privilege flag
  1653.        IF NOT FLAG(1) GOTO Bull_Scan; Only display if privileged user
  1654.     ENDIF
  1655. ;
  1656. ;    Test for file availability
  1657. ;
  1658.     S8 = S9(14:25)            ; Extract File name
  1659.     IF NOT ISFILE S8 GOTO Bull_Scan ; If file dosn't exist
  1660. ;
  1661. ;    Test the record number field against the given
  1662. ;
  1663.     S9 = S9(0:4)            ; Extract just the number
  1664.     LJ S9                ; Justify the field in S9; S0 already so
  1665.     SWITCH S9            ; Test using the given #
  1666.        CASE S0(0:4)         ; .. against the rec number field
  1667.           GOTO Bull_Read        ; Match - go read it
  1668.        ENDCASE
  1669.     ENDSWITCH
  1670.     GOTO Bull_Scan            ; Loop until EOF
  1671. ;
  1672. ;    Read a single bulletin - the name is in S8
  1673. ;
  1674. Bull_Read:
  1675.     FCLOSEI             ; Close the mail keys file
  1676.     MESS "^M^JReading bulletin: "*S8; Local console indicator
  1677.  
  1678.     S9 = "^M^JError opening bulletin file" ; Error msg just in case
  1679.     GOSUB Disp_File         ; Display the file
  1680. ;
  1681. ;    Log the fact
  1682. ;
  1683.     S9 = "Bulletin "*S8&" read"
  1684.     GOSUB Log_Item            ; Write to BBS-Log
  1685.     GOTO Bull_Prompt        ; And loop until EOF
  1686. ; -----------------------------------------------------------------------
  1687. ;    Mail command: Read, write or back to main
  1688. ;
  1689. ;    Note: S19 must be retained throughout this submenu...
  1690. ;          It is used to save the current subdir
  1691. ; -----------------------------------------------------------------------
  1692. ;
  1693. Mail_Command:
  1694.     MESS "^M^JMail prompt: "        ; Local console indicator
  1695.     SUBDIR S19            ; Save current default
  1696.     CHDIR S24            ; Set to Messages subdir
  1697. ;
  1698. ;    Prompt for a submenu command
  1699. ;
  1700. Mail_Prompt:
  1701.     GOSUB Display_Limit        ; Report amount of time remaining
  1702.     S9 = "^M^JS)can, L)ist, N)ew, A)ll, W)rite, M)ain or E)xit: "
  1703.     S8 = "BBS-MeMe"                 ; Set file name
  1704.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  1705. ;
  1706. ;    Keep just the first char entered
  1707. ;
  1708.     GOSUB Read_Comm         ; Read into S9
  1709.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1710.  
  1711.     LJ S9                ; Left justify S9
  1712.     S9 = S9(0:0)            ; Keep just the first char
  1713. ;
  1714. ;    Interpret the command
  1715. ;
  1716.     SWITCH S9            ; Test the entry
  1717.     ;
  1718.     ;    Read-new command
  1719.     ;
  1720.        CASE "N"                     ; New-Read
  1721.           GOTO Read_New
  1722.        ENDCASE
  1723.     ;
  1724.     ;    Read command
  1725.     ;
  1726.        CASE "A"                     ; All-Read
  1727.           GOTO Read_All
  1728.        ENDCASE
  1729.     ;
  1730.     ;    Write command
  1731.     ;
  1732.        CASE "W"                     ; Write
  1733.           GOTO Write_msg
  1734.        ENDCASE
  1735.     ;
  1736.     ;    Scan command
  1737.     ;
  1738.        CASE "S"                     ; Scan
  1739.           GOTO Scan_Msg
  1740.        ENDCASE
  1741.     ;
  1742.     ;    List command
  1743.     ;
  1744.        CASE "L"                     ; Scan
  1745.           GOTO List_Msg
  1746.        ENDCASE
  1747.     ;
  1748.     ;    Main command
  1749.     ;
  1750.        CASE "M"                     ; Go back to main prompt
  1751.           CHDIR S19         ; Reset subdir
  1752.           GOTO Main_Prompt
  1753.        ENDCASE
  1754.     ;
  1755.     ;    Exit command
  1756.     ;
  1757.        CASE "E"                     ; Exit
  1758.           GOTO Logoff        ; Transmit acknowlegement and Exit
  1759.        ENDCASE
  1760.     ENDSWITCH
  1761.  
  1762.     TRAN "Invalid selection - try again^M^J"
  1763.     GOTO Mail_Prompt
  1764. ; -----------------------------------------------------------------------
  1765. ;    Scan command: Scan for files 'to' the current user
  1766. ;
  1767. ;    The MAILKEY file is structured:
  1768. ;    0      8        16 17     25       38
  1769. ;    +---/ /---+---/ /---+--+---/ /---+---/ /---+-------/ /--------+
  1770. ;    ! To ID   ! From ID !  ! Date     ! Fname   ! Subject (40 char)!
  1771. ;    +---/ /---+---/ /---+--+---/ /---+---/ /---+-------/ /--------+
  1772. ;                 ^Privacy flag = P
  1773. ; -----------------------------------------------------------------------
  1774. ;
  1775. Scan_Msg:
  1776.     N10 = 0             ; Initialize counter (# records)
  1777.     N11 = 0             ; Initialize counter (# to current ID)
  1778.  
  1779.     FOPENI "BBS-Mail"  TEXT         ; Open the mailkey file
  1780.     IF FAILED GOTO Scan_Rpt     ; IF error opening, Use zero cnt
  1781.     TRAN "^M^JWorking..."           ; May take a moment
  1782. ;
  1783. ;    Read records from BBS_Mail
  1784. ;
  1785. Scan_Loop:
  1786.     READ S9 80 N19            ; Read a record
  1787.     IF EOF GOTO Scan_Rpt        ; On end of file, report count found
  1788.  
  1789.     S0 = S9(0:7)            ; Look at 'to ID' field
  1790.     SWITCH S0            ; Test for our ID
  1791.        CASE S1            ; .. in the record
  1792.           S0 = S9(25:37)        ; Extract File name
  1793.           IF ISFILE S0 INC N11      ; If file exists, count it
  1794.        ENDCASE
  1795.     ENDSWITCH
  1796.  
  1797.     INC N10             ; Count the read
  1798.     N12 = N10/10*10         ; Every 10th record
  1799.     IF EQ N10 N12            ; .. or so
  1800.       TRAN "."                     ; .. indicate we didn't die
  1801.     ENDIF
  1802.     GOTO Scan_Loop            ; Loop until EOF
  1803. ;
  1804. ;    Report the count found
  1805. ;
  1806. Scan_Rpt:
  1807.     IF ZERO N11            ; If no files found
  1808.       TRAN "^M^JYou have no messages waiting"
  1809.     ELSE
  1810.        STRFMT S0 "^M^JYou have %d message(s) waiting." N11
  1811.       TRAN S0            ; Transmit the text
  1812.        ENDIF
  1813.  
  1814.     FCLOSEI             ; CLOSE the keys file
  1815.     GOTO Mail_Prompt        ; And loop until EOF
  1816. ; -----------------------------------------------------------------------
  1817. ;    Mail List command: List files available to be read.
  1818. ; -----------------------------------------------------------------------
  1819. ;
  1820. List_Msg:
  1821.     N10 = 0             ; Initialize counter (# records)
  1822.  
  1823.     FOPENI "BBS-Mail"  TEXT         ; Open the mailkey file
  1824.     IF FAILED            ; IF error opening
  1825.       TRAN "^M^JNo mail exists - why not write something?^M^J"
  1826.        GOTO Mail_Prompt        ; And go back to mainline
  1827.     ENDIF
  1828. ;
  1829. ;    Read a record from BBS-Mail
  1830. ;
  1831. List_Loop:
  1832.     READ S9 80 N19            ; Read a record
  1833.     IF EOF GOTO List_End        ; On end of file, report count found
  1834.  
  1835.     S0 = S9(0:7)            ; Look at 'to ID' field
  1836.     SWITCH S0            ; Test for our ID
  1837.        CASE S1            ; .. in the record
  1838.        ENDCASE            ; OK if addressed to us
  1839.        DEFAULT            ; If not our ID, test privacy
  1840.          IF FIND S9(16:16) "P"      ; Test privacy flag
  1841.         IF NOT STRCMP S9(8:15) S1 ; If we didn't write it
  1842.            GOTO List_Loop    ; Ignore private messages
  1843.            ENDIF
  1844.         ENDIF
  1845.        ENDCASE
  1846.     ENDSWITCH
  1847.  
  1848.     S0 = S9(25:37)            ; Extract File name
  1849.     IF NOT ISFILE S0 GOTO List_Loop ; If file dosn't exist
  1850. ;
  1851. ;    If nothing has been displayed yet, do a heading
  1852. ;
  1853.     IF ZERO N10            ; If no recs displayed yet
  1854.       TRAN "^M^JTo       From     Date     Subject^M^J"
  1855.        TRAN "-------- -------- -------- -------------------------------------------------^M^J"
  1856.        ENDIF
  1857. ;
  1858. ;    And display the record
  1859. ;
  1860.     S0 = S9(0:7)*" "*S9(8:15)*" "*S9(17:24)*" "*S9(38:79)
  1861.     TRAN S0             ; Display the record
  1862.     TRAN "^M^J"                     ; And a cr/lf
  1863.     N10 = N10+1            ; COunt this one
  1864.     GOTO List_Loop            ; Loop until EOF
  1865. ;
  1866. ;    End of loop
  1867. ;
  1868. List_End:
  1869.     FCLOSEI             ; CLOSE the keys file
  1870.     GOTO Mail_Prompt        ; And loop until EOF
  1871. ; -----------------------------------------------------------------------
  1872. ;    Read NEW command: Read NEW mail files 'to' the current user
  1873. ;    Setup S7 limiting date
  1874. ; -----------------------------------------------------------------------
  1875. ;
  1876. Read_New:
  1877.     S7 = "        "                 ; Make earliest possible date
  1878.     IF NOT ISFILE S1&".NEW" GOTO Read_Msg
  1879.     FOPENI S1&".NEW" TEXT           ; Open ID.NEW file
  1880.     IF FAILED GOTO Read_Msg     ; Skip on error
  1881.     READ S7 8 N19            ; Read oldest date read
  1882.     FCLOSEI             ; Close file
  1883.     GOTO Read_Msg            ; And read using this date
  1884. ; -----------------------------------------------------------------------
  1885. ;    Read ALL command: Read ALL mail files 'to' the current user
  1886. ;    Setup S7 limiting date
  1887. ; -----------------------------------------------------------------------
  1888. ;
  1889. Read_All:
  1890.     S7 = "        "                 ; Make earliest possible date
  1891.     GOTO Read_Msg            ; And read using this date
  1892. ; -----------------------------------------------------------------------
  1893. ;    Test two dates, one in S0 and one in S2  (each fmttd mm/dd/yy)
  1894. ;    N10 returns -1 if S0 date < S2 date
  1895. ;             0 if S0 date = S2 date
  1896. ;            +1 if S0 date > S2 date
  1897. ; -----------------------------------------------------------------------
  1898. ;
  1899. DateTest:
  1900.     IF NOT NUMERIC S2(0) or NOT NUMERIC S2(3) or NOT NUMERIC S2(6)
  1901.        N10 = 0            ; Fake they're equal
  1902.        RETURN            ; .. and done
  1903.        ENDIF
  1904.  
  1905.     IF NOT NUMERIC S0(0) or NOT NUMERIC S0(3) or NOT NUMERIC S0(6)
  1906.        N10 = 0            ; Fake they're equal
  1907.        RETURN            ; .. and done
  1908.        ENDIF
  1909.  
  1910.     IF S0(6:7) EQ S2(6:7)        ; If recordyear = limityear
  1911.        N10 = (S0(0:1)*100+S0(3:4)) - (S2(0:1)*100+S2(3:4))
  1912.        IF N10 LT 0            ; S0 < S2
  1913.           N10 = -1            ; Return S0 < S2
  1914.        ELSE
  1915.           IF N10 GT 0        ; S0 > S2
  1916.          N10 = 1        ; Return S0 > S2
  1917.           ELSE
  1918.          N10 = 0        ; Return S0 = S2
  1919.          ENDIF
  1920.           ENDIF
  1921.        RETURN            ; And we're done here
  1922.        ENDIF
  1923.  
  1924.     N10 = S0(6:7)+1900        ; Extract S0 year, dft 1900 century
  1925.     N11 = S2(6:7)+1900        ; Extract S2 year, dft 1900 century
  1926.     IF S0(6:7) LT 80 N10 = N10+100    ; 00-79 -> 2000 century
  1927.     IF S2(6:7) LT 80 N11 = N10+100    ; 00-79 -> 2000 century
  1928.  
  1929.     IF N10 LT N11            ; S0 < S2
  1930.        N10 = -1            ; Return S0 < S2
  1931.     ELSE
  1932.        IF N10 GT N11        ; S0 > S2
  1933.           N10 = 1            ; Return S0 > S2
  1934.        ELSE
  1935.           N10 = 0            ; Return S0 = S2
  1936.           ENDIF
  1937.        ENDIF
  1938.     RETURN
  1939. ; -----------------------------------------------------------------------
  1940. ;    Read command: Read mail files 'to' the current user
  1941. ;    S7 passes the date on/after which to read (formatted yymmdd)
  1942. ;    S2 will be used to keep the date of the last record read
  1943. ;    S3 will be used to keep latest date read
  1944. ;    S4 will be used to keep the sender ID
  1945. ;    S5 will be used to keep the subject text
  1946. ; -----------------------------------------------------------------------
  1947. ;
  1948. Read_Msg:
  1949.     FOPENI "BBS-Mail"  TEXT         ; Open the mailkey file
  1950.     IF FAILED            ; IF error opening
  1951.       TRAN "^M^JNo mail exists - why not write something?^M^J"
  1952.        GOTO Mail_Prompt        ; And continue
  1953.     ENDIF
  1954.     S3 = "        "                 ; Date of oldest note read
  1955. ;
  1956. ;    Read a line from BBS-Mail
  1957. ;
  1958. Read_Loop:
  1959.     READ S9 80 N19            ; Read a record
  1960.     IF EOF GOTO Read_End        ; On end of file, exit
  1961. ;
  1962. ;    Test the date of the item against the passed limiting date
  1963. ;    .. if either contain non-alpha, skip this step
  1964. ;
  1965.     S2 = S9(17:24)            ; Extract date from record
  1966.     S0 = S7             ; Setup limiting date for compare
  1967.     GOSUB DateTest            ; Compare date in S0 to date in S7
  1968.     IF N10 GT 0 GOTO Read_Loop    ; Skip if limitdate > recorddate
  1969. ;
  1970. ;    Test the ID from the record
  1971. ;
  1972.     S0 = S9(0:7)            ; Look at 'to ID' field
  1973.     SWITCH S0            ; Test ID from the record
  1974.     ;
  1975.     ;    Test for mail to current caller
  1976.     ;
  1977.        CASE S1            ; Against our own ID
  1978.           SET FLAG(9) ON        ; Flag for delete
  1979.        ENDCASE
  1980.     ;
  1981.     ;    Not to current caller - test sender/privacy
  1982.     ;
  1983.        DEFAULT            ; If not our ID, test privacy
  1984.           SET FLAG(9) OFF        ; Flag no delete
  1985.           IF STRCMP S9(8:15) S1 SET FLAG(9) ON ; If we wrote it
  1986.           IF FIND S9(16:16) "P" and NOT FLAG(9)
  1987.          GOTO Read_Loop     ; So.. ignore private messages
  1988.          ENDIF
  1989.        ENDCASE
  1990.     ENDSWITCH
  1991. ;
  1992. ;    We'll read the message
  1993. ;
  1994.     S0 = S9(25:37)            ; Extract File name
  1995.     IF NOT ISFILE S0 GOTO Read_Loop ; If file dosn't exist
  1996. ;
  1997. ;    Save a few values for reply...
  1998. ;
  1999.     S4 = S9(8:15)            ; Setup from-ID for later
  2000.     S5 = S9(38:79)            ; Save subject for later too
  2001. ;
  2002. ;    Display the current file
  2003. ;
  2004.     S8 = S0             ; Set-up file name
  2005.     S9 = "^M^JError opening mailfile"
  2006.     GOSUB Disp_File         ; Display the file
  2007. ;
  2008. ;    Save the date of the record read (S2 contains record date)
  2009. ;
  2010.     S0 = S3             ; Setup oldest date read
  2011.     GOSUB DateTest            ; Compare the two dates
  2012.     IF NULL S3 or N10 LT 0 S3 = S2    ; If oldestdate < recorddate, save new oldest
  2013. ;
  2014. ;    Prompt for next action
  2015. ;
  2016. Read_Disposition:
  2017.     IF FLAG(9)            ; If delete is possible
  2018.       TRAN "^M^JD)elete, R)eply, Q)uit (cr=continue): "
  2019.     ELSE                ; Delete not possible
  2020.       TRAN "^M^JR)eply, Q)uit (cr=continue): "
  2021.     ENDIF
  2022.     GOSUB Read_Comm         ; Read into S9
  2023.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  2024.  
  2025.     LJ S9                ; Left justify S9
  2026.     S9 = S9(0:0)            ; Keep just the first char
  2027.     IF NULL S9 S9 = "c"             ; Fake 'continue'
  2028. ;
  2029. ;    Interpret the command
  2030. ;
  2031.     SWITCH S9            ; Test the entry
  2032.     ;
  2033.     ;    Delete command
  2034.     ;
  2035.        CASE "D"                     ; Delete
  2036.         IF FLAG(9)        ; If it was ours
  2037.            DELETE S8        ; Delete file named in S8
  2038.            TRAN "Message deleted^M^J"; Indicate its done
  2039.         ELSE
  2040.            TRAN "You may not delete this note^M^J"
  2041.         ENDIF
  2042.        ENDCASE
  2043.     ;
  2044.     ;    Reply command
  2045.     ;
  2046.        CASE "R"                     ; All-Read
  2047.           S10 = S4            ; Reply To-ID is current note from-id
  2048.           S11 = S5            ; Default reply subj text
  2049.           IF NOT STRCMP S5(0:9) "Reply to: " S11 = "Reply to: "*S5
  2050.           GOSUB Reply        ; COmpose the reply
  2051.           IF FLAG(0) GOTO Exit    ; Exit on disconn
  2052.        ENDCASE
  2053.     ;
  2054.     ;    Continue command
  2055.     ;
  2056.        CASE "C"                     ; Continue
  2057.           GOTO Read_Loop
  2058.        ENDCASE
  2059.     ;
  2060.     ;    Quit command
  2061.     ;
  2062.        CASE "Q"                     ; Quit
  2063.           GOTO Read_End
  2064.        ENDCASE
  2065.     ;
  2066.     ;    Unrecognized command
  2067.     ;
  2068.        DEFAULT            ; Anything else
  2069.           TRAN "^M^JUnrecognized command - please try again^M^J"
  2070.        ENDCASE
  2071.     ENDSWITCH
  2072.     GOTO Read_Disposition
  2073. ;
  2074. ;    End of read... close input file, and we're done
  2075. ;
  2076. Read_End:
  2077.     FCLOSEI             ; Close the mail keys file
  2078.     IF NOT NULL S3            ; If we read something
  2079.        FOPENO S1&".NEW" TEXT        ; Open ID.NEW file
  2080.        IF FAILED GOTO Mail_Prompt    ; Skip on error
  2081.        WRITE S3*"!"                 ; Write saved date
  2082.        FCLOSEO            ; Close file
  2083.     ENDIF
  2084.     GOTO Mail_Prompt        ; And loop until EOF
  2085. ; -----------------------------------------------------------------------
  2086. ;    Write command - write mail
  2087. ; -----------------------------------------------------------------------
  2088. ;
  2089. Write_Msg:
  2090.     GOSUB Compose            ; Invoke compose a note
  2091.     IF FLAG(0) GOTO Exit        ; Exit on disconn
  2092.     GOTO Mail_Prompt        ; GO for next cmd
  2093. ; -----------------------------------------------------------------------
  2094. ;    Write a mail note - this is a subroutine, as it is called by both
  2095. ;    Read-mail (reply) and Write-Mail.  Note:
  2096. ;    S3 and S7 must be preserved for Read_Msg...
  2097. ;    The caller must test FLAG(0) for disconn...
  2098. ;    An existing FOPENI must be preserved
  2099. ; -----------------------------------------------------------------------
  2100. ;    The entry point 'Reply' requires that S10 contain the TO ID and
  2101. ;    S11 contain the subject line
  2102. ; -----------------------------------------------------------------------
  2103. ;
  2104. Compose:
  2105.     TRAN "To:  ^H"                  ; Prompt for ID
  2106.     GOSUB Read_Comm         ; Read a response
  2107.     IF FLAG(0) RETURN        ; If first flag rtns set, disconn
  2108.  
  2109.     LJ S9                ; Left justify ID
  2110.     IF NULL S9 RETURN        ; If blank entry - exit here
  2111.     S10 = S9(0:7)            ; Save TO ID
  2112.     UPPER S10            ; Force it upper case
  2113. ;
  2114. ;    Prompt for a subject
  2115. ;
  2116.     TRAN "Subject:  ^H"             ; Prompt for subject
  2117.     GOSUB Read_Comm         ; Read a response
  2118.     IF FLAG(0) RETURN        ; If first flag rtns set, disconn
  2119.     S11 = S9            ; Save returned subject
  2120. ;
  2121. ;    Open a temporary file
  2122. ;
  2123. Reply:
  2124.     FOPENO "\HOSTTEMP.TXT" TEXT     ; OPEN file for output
  2125.     IF FAILED            ; if open failed
  2126.        TRAN "Error opening file - please try later^M^J"
  2127.        RETURN            ; Back to submenu
  2128.     ENDIF
  2129. ;
  2130. ;    Place a header
  2131. ;
  2132.     S9 = "To:    "                  ; Set Sender ID
  2133.     CONCAT S9(7) S10        ; ..
  2134.     WRITE S9            ; Write header to file     * COM-AND
  2135.     WRITE "!"                       ; Write a record delim   * COM-AND
  2136.  
  2137.     S9 = "From: "                   ; Set Sender ID
  2138.     CONCAT S9(7) S1         ; ..
  2139.     WRITE S9            ; Write header to file     * COM-AND
  2140.     WRITE "!"                       ; Write a record delim   * COM-AND
  2141.  
  2142.     S9 = "Date: "                   ; Set date and time
  2143.     DATE S12
  2144.     CONCAT S9(7) S12        ; Add date
  2145.     TIME S8 1            ; (military fmt)
  2146.     CONCAT S9(17) S8        ; Add time
  2147.     WRITE S9            ; Write header to file     * COM-AND
  2148.     WRITE "!"                       ; Write a record delim   * COM-AND
  2149.  
  2150.     S9 = "Subject: "                ; Set subject
  2151.     CONCAT S9(9)  S11        ; ..
  2152.     WRITE S9            ; Write header to file     * COM-AND
  2153.     WRITE "!"                       ; Write a record delim   * COM-AND
  2154.     WRITE "!"                       ; Write a text delim     * COM-AND
  2155. ;
  2156. ;    Ask for lines, and write them to the output file
  2157. ;
  2158.     TRAN "Each line, as you enter it will be recorded.  No edits, yet...^M^J"
  2159.     TRAN "Enter a line/line(s) of text.  A blank line ends the text.^M^J"
  2160.     GOSUB Copy_Text         ; Note FLAG(0) test below
  2161.     FCLOSEO             ; Close the file
  2162.     IF FLAG(0) RETURN        ; If first flag rtns set, disconn
  2163. ;
  2164. ;    Ask if the file is to be saved
  2165. ;
  2166.     TRAN "Save? (Y/N, cr=y):  ^H"   ; Ask if its to be saved
  2167.     GOSUB Read_Comm         ; Read a response
  2168.     IF FLAG(0) RETURN        ; If first flag rtns set, disconn
  2169.  
  2170.     IF FIND S9 "N" RETURN           ; Test for "N"
  2171. ;
  2172. ;    Now - scan for the last used file name
  2173. ;
  2174.     TRAN "^M^JScanning for free slot"
  2175.     N10 = 0             ; Set default extension we'll use
  2176.     S0 = S10(0:7)            ; Look at 'to ID' field
  2177. ;
  2178. ;    Look for a free file name
  2179. ;
  2180.     WHILE ISFILE S0&"."&N10         ; Find unused note #
  2181.           INC N10            ; Bump ptr
  2182.           IF N10 GT 999        ; If max msgs reached...
  2183.          TRAN "^M^JToo many notes left undeleted - cannot save^M^J"
  2184.         RETURN         ; Back to caller
  2185.          ENDIF
  2186.           ENDWHILE            ; Loop until match
  2187. ;
  2188. ;    We have found the first free file name
  2189. ;
  2190.     TRAN "^M^JPrivate? (Y/N, cr=n): "; Ask if its to a private msg
  2191.     GOSUB Read_Comm         ; Read a response
  2192.     IF FLAG(0) RETURN        ; If first flag rtns set, disconn
  2193.  
  2194.     S13 = " "                       ; Set privacy flag
  2195.     IF FIND S9 "Y" S13 = "P"        ; Test for "Y" - set flag val
  2196.  
  2197.     S0 = S0&"."&N10                 ; Make a new file name
  2198.     S9 = "COPY \HOSTTEMP.TXT " * S0 ; Make a copy command
  2199.     DOS S9                ; Cannot do own copy (FOPENI in use)
  2200.  
  2201.     FOPENO "BBS-Mail" TEXT APPEND   ; Open the keys file for append
  2202.     WRITE S10 8            ; Write the 'TO ID'
  2203.     WRITE S1  8            ; Write the from ID
  2204.     WRITE S13 1            ; Write privacy flag
  2205.     WRITE S12 8            ; Write date
  2206.     WRITE S0  13            ; Write file name
  2207.     WRITE S11 50            ; Write the subject
  2208.     WRITE "!"                       ; And a delimiter
  2209.     FCLOSEO             ; ANd close the keys file
  2210.     RETURN                ; GO for next cmd
  2211. ; -----------------------------------------------------------------------
  2212. ;    Registration (Exit must be performed after)
  2213. ;
  2214. ;    Upon return: FLAG(0) ON -> Caller disconnected
  2215. ; -----------------------------------------------------------------------
  2216. ;
  2217. Register:
  2218.     MESS "^M^JRegistration requested "
  2219.     S9 = "Do you wish to register? (Y/N, cr=y): "
  2220.     S8 = "BBS-ReMe"                 ; Set file name
  2221.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  2222.  
  2223.     GOSUB Read_Comm         ; Read a response
  2224.     IF FLAG(0)            ; If error
  2225.        S9 = "Registration aborted - disconn"
  2226.        GOSUB Log_Item        ; Log the fact
  2227.        RETURN            ; SImply return
  2228.     ENDIF
  2229.  
  2230.     IF FIND S9 "N"                  ; IF answer wasn't 'n'
  2231.        S9 = "Registration declined by caller"
  2232.        GOSUB Log_Item        ; Log the fact
  2233.        TRAN "OK - bye^M^J"          ; Say g'night Gracie
  2234.     RETURN            ; We're done.
  2235.     ENDIF
  2236. ;
  2237. ;    Ask for a name/address/csz phone and ID/Password
  2238. ;
  2239.     TRAN "Enter your full name: "
  2240.     GOSUB Read_Comm         ; Read a response
  2241.     IF FLAG(0) RETURN        ; If error
  2242.     S18 = S9            ; Save return
  2243.  
  2244.     TRAN "Enter your street address: "
  2245.     GOSUB Read_Comm         ; Read a response
  2246.     IF FLAG(0) RETURN        ; If error
  2247.     S17 = S9            ; Save return
  2248.  
  2249.     TRAN "Enter your city/state and zip: "
  2250.     GOSUB Read_Comm         ; Read a response
  2251.     IF FLAG(0) RETURN        ; If error
  2252.     S16 = S9            ; Save return
  2253.  
  2254.     TRAN "Enter a area code and phone number where^M^J"
  2255.     TRAN "you may be reached:  "
  2256.     GOSUB Read_Comm         ; Read a response
  2257.     IF FLAG(0) RETURN        ; If error
  2258.     S15 = S9            ; Save return
  2259. ;
  2260. ;    Request an ID
  2261. ;
  2262. Reg_ID:
  2263.     TRAN "Enter the ID (1-8 chars) you wish to use: "
  2264.     GOSUB Read_Comm         ; Read a response
  2265.     IF FLAG(0) RETURN        ; If error
  2266.  
  2267.     IF FIND S9(0:7) "."
  2268.        TRAN "ID may not contain '.'s^M^J"
  2269.        GOTO Reg_ID
  2270.     ENDIF
  2271.     IF FIND S9(0:7) ","
  2272.        TRAN "ID may not contain ','s^M^J"
  2273.        GOTO Reg_ID
  2274.     ENDIF
  2275.     IF FIND S9(0:7) "\"
  2276.        TRAN "ID may not contain '\'s^M^J"
  2277.        GOTO Reg_ID
  2278.     ENDIF
  2279.     IF FIND S9(0:7) "/"
  2280.        TRAN "ID may not contain '/'s^M^J"
  2281.        GOTO Reg_ID
  2282.     ENDIF
  2283.     S14 = S9(0:7)            ; Save return
  2284. ;
  2285. ;    Request a password
  2286. ;
  2287. Reg_Pass:
  2288.     TRAN "Enter the password (1-8 chars) you wish to use: "
  2289.     GOSUB Read_Comm         ; Read a response
  2290.     IF FLAG(0) RETURN        ; If error
  2291.  
  2292.     IF NULL S9(0:7)         ; Test for blank entered
  2293.        TRAN "You must have a password^M^J"
  2294.        GOTO Reg_Pass
  2295.     ENDIF
  2296.     S14 = S14 & ";" &S9(0:7)        ; Concatenate PASSWORD to ID
  2297. ;
  2298. ;    Repeat for validity:
  2299. ;
  2300.     TRAN "^M^JRepeating your entry...^M^J"
  2301.     TRAN S18            ; Transmit name
  2302.     TRAN "^M^J"
  2303.     TRAN S17            ; Transmit Street address
  2304.     TRAN "^M^J"
  2305.     TRAN S16            ; Transmit CSZ
  2306.     TRAN "^M^J"
  2307.     TRAN S15            ; Transmit Phone
  2308.     TRAN "^M^J"
  2309.     TRAN S14            ; Transmit ID/password
  2310.  
  2311.     TRAN "^M^JIs this correct? (Y/N, cr=n): "
  2312.     GOSUB Read_Comm         ; Read a response
  2313.     IF FLAG(0) RETURN        ; If error
  2314.  
  2315.     FIND S9 "Y"                     ; Look for "Y"
  2316.     IF NOT FOUND GOTO Register    ; IF answer wan't 'Y', try again
  2317. ;
  2318. ;    Open the comments file
  2319. ;
  2320.     FOPENO "BBS-Note" TEXT APPEND   ; OPEN file for input
  2321.     IF FAILED            ; if open failed
  2322.        TRAN "Error recording registration - please call back^M^J"
  2323.        RETURN            ; Return to caller
  2324.     ENDIF
  2325.  
  2326.     S9 = "*** Registration requested: "
  2327.     DATE S1
  2328.     CONCAT S9(27) S1        ; S1 would be ID anyway
  2329.     TIME S1 1            ; (military fmt)
  2330.     CONCAT S9(38) S1
  2331.     WRITE S9            ; Write a record     * COM-AND
  2332.     WRITE "!"                       ; Write a record delim   * COM-AND
  2333.  
  2334.     WRITE S18 80            ; Write a record     * COM-AND
  2335.     WRITE "!"                       ; Write a record delim   * COM-AND
  2336.     WRITE S17 80            ; Write a record     * COM-AND
  2337.     WRITE "!"                       ; Write a record delim   * COM-AND
  2338.     WRITE S16 80            ; Write a record     * COM-AND
  2339.     WRITE "!"                       ; Write a record delim   * COM-AND
  2340.     WRITE S15 80            ; Write a record     * COM-AND
  2341.     WRITE "!"                       ; Write a record delim   * COM-AND
  2342.     WRITE S14 80            ; Write a record     * COM-AND
  2343.     WRITE "!"                       ; Write a record delim   * COM-AND
  2344.     WRITE "------------!"           ; Write a delimiter
  2345. ;
  2346. ;    Log the fact
  2347. ;
  2348.     S9 = "Registration requested"
  2349.     GOSUB Log_Item            ; Write to BBS-Log
  2350. ;
  2351. ;    We have a successful record
  2352. ;
  2353.     TRAN "Your request will be processed by the SYSOP^M^J"
  2354.     TRAN "Thanks for calling...^M^J"
  2355.  
  2356.     FCLOSEO             ; CLose the file
  2357.     RETURN                ; Return from subroutine
  2358. ; -----------------------------------------------------------------------
  2359. ;    Auto baudrate detect (according to message in S9)
  2360. ;
  2361. ;    This procedure is placed last to ensure that the entire script
  2362. ;    file is scanned once before the main prompt.  COM-AND caches
  2363. ;    label addresses, so this ensures that the 1st 100 labels are
  2364. ;    known by COM-AND (and thus can be quickly reached).
  2365. ; -----------------------------------------------------------------------
  2366. ;
  2367. AutoBaud:
  2368.     IF FIND S9 "1200"
  2369.        SET BAUD 1200        ; Set to new rate
  2370.        GOTO AUBA100         ; Log the fact
  2371.        ENDIF
  2372.  
  2373.     IF FIND S9 "2400"
  2374.        SET BAUD 2400        ; Set to new rate
  2375.        GOTO AUBA100         ; Log the fact
  2376.        ENDIF
  2377.  
  2378.     IF FIND S9 "4800"
  2379.        SET BAUD 4800        ; Set to new rate
  2380.        GOTO AUBA100         ; Log the fact
  2381.        ENDIF
  2382.  
  2383.     IF FIND S9 "9600"
  2384.        SET BAUD 9600        ; Set to new rate
  2385.        GOTO AUBA100         ; Log the fact
  2386.        ENDIF
  2387.  
  2388.     IF FIND S9 "19200"
  2389.        SET BAUD 19.2        ; Set to new rate
  2390.        GOTO AUBA100         ; Log the fact
  2391.        ENDIF
  2392.  
  2393.     IF FIND S9 "19.2"
  2394.        SET BAUD 19.2        ; Set to new rate
  2395.        GOTO AUBA100         ; Log the fact
  2396.        ENDIF
  2397. ;
  2398. ;    None of the above... set to 300
  2399. ;
  2400.     SET BAUD 300            ; Set to 1200 baud
  2401. ;
  2402. ;    Log the connect string to the log
  2403. ;
  2404. AUBA100:
  2405.     GOSUB Log_Item            ; Write connect string to log
  2406.     RETURN                ; We're done.
  2407.